home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / perl5.002 / pp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-06-04  |  65.2 KB  |  3,554 lines  |  [TEXT/MPS ]
  1. /*    pp.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "It's a big house this, and very peculiar.  Always a bit more to discover,
  12.  * and no knowing what you'll find around a corner.  And Elves, sir!" --Samwise
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #include "perl.h"
  17.  
  18. static void doencodes _((SV *sv, char *s, I32 len));
  19.  
  20. /* variations on pp_null */
  21.  
  22. PP(pp_stub)
  23. {
  24.     dSP;
  25.     if (GIMME != G_ARRAY) {
  26.     XPUSHs(&sv_undef);
  27.     }
  28.     RETURN;
  29. }
  30.  
  31. PP(pp_scalar)
  32. {
  33.     return NORMAL;
  34. }
  35.  
  36. /* Pushy stuff. */
  37.  
  38. PP(pp_padav)
  39. {
  40.     dSP; dTARGET;
  41.     if (op->op_private & OPpLVAL_INTRO)
  42.     SAVECLEARSV(curpad[op->op_targ]);
  43.     EXTEND(SP, 1);
  44.     if (op->op_flags & OPf_REF) {
  45.     PUSHs(TARG);
  46.     RETURN;
  47.     }
  48.     if (GIMME == G_ARRAY) {
  49.     I32 maxarg = AvFILL((AV*)TARG) + 1;
  50.     EXTEND(SP, maxarg);
  51.     Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
  52.     SP += maxarg;
  53.     }
  54.     else {
  55.     SV* sv = sv_newmortal();
  56.     I32 maxarg = AvFILL((AV*)TARG) + 1;
  57.     sv_setiv(sv, maxarg);
  58.     PUSHs(sv);
  59.     }
  60.     RETURN;
  61. }
  62.  
  63. PP(pp_padhv)
  64. {
  65.     dSP; dTARGET;
  66.     XPUSHs(TARG);
  67.     if (op->op_private & OPpLVAL_INTRO)
  68.     SAVECLEARSV(curpad[op->op_targ]);
  69.     if (op->op_flags & OPf_REF)
  70.     RETURN;
  71.     if (GIMME == G_ARRAY) { /* array wanted */
  72.     RETURNOP(do_kv(ARGS));
  73.     }
  74.     else {
  75.     SV* sv = sv_newmortal();
  76.     if (HvFILL((HV*)TARG)) {
  77.         sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1);
  78.         sv_setpv(sv, buf);
  79.     }
  80.     else
  81.         sv_setiv(sv, 0);
  82.     SETs(sv);
  83.     RETURN;
  84.     }
  85. }
  86.  
  87. PP(pp_padany)
  88. {
  89.     DIE("NOT IMPL LINE %d",__LINE__);
  90. }
  91.  
  92. /* Translations. */
  93.  
  94. PP(pp_rv2gv)
  95. {
  96.     dSP; dTOPss;
  97.     
  98.     if (SvROK(sv)) {
  99.       wasref:
  100.     sv = SvRV(sv);
  101.     if (SvTYPE(sv) != SVt_PVGV)
  102.         DIE("Not a GLOB reference");
  103.     }
  104.     else {
  105.     if (SvTYPE(sv) != SVt_PVGV) {
  106.         char *sym;
  107.  
  108.         if (SvGMAGICAL(sv)) {
  109.         mg_get(sv);
  110.         if (SvROK(sv))
  111.             goto wasref;
  112.         }
  113.         if (!SvOK(sv)) {
  114.         if (op->op_flags & OPf_REF ||
  115.             op->op_private & HINT_STRICT_REFS)
  116.             DIE(no_usym, "a symbol");
  117.         RETSETUNDEF;
  118.         }
  119.         sym = SvPV(sv, na);
  120.         if (op->op_private & HINT_STRICT_REFS)
  121.         DIE(no_symref, sym, "a symbol");
  122.         sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
  123.     }
  124.     }
  125.     if (op->op_private & OPpLVAL_INTRO) {
  126.     GP *ogp = GvGP(sv);
  127.  
  128.     SSCHECK(3);
  129.     SSPUSHPTR(SvREFCNT_inc(sv));
  130.     SSPUSHPTR(ogp);
  131.     SSPUSHINT(SAVEt_GP);
  132.  
  133.     if (op->op_flags & OPf_SPECIAL) {
  134.         GvGP(sv)->gp_refcnt++;        /* will soon be assigned */
  135.         GvINTRO_on(sv);
  136.     }
  137.     else {
  138.         GP *gp;
  139.         Newz(602,gp, 1, GP);
  140.         GvGP(sv) = gp;
  141.         GvREFCNT(sv) = 1;
  142.         GvSV(sv) = NEWSV(72,0);
  143.         GvLINE(sv) = curcop->cop_line;
  144.         GvEGV(sv) = sv;
  145.     }
  146.     }
  147.     SETs(sv);
  148.     RETURN;
  149. }
  150.  
  151. PP(pp_rv2sv)
  152. {
  153.     dSP; dTOPss;
  154.  
  155.     if (SvROK(sv)) {
  156.       wasref:
  157.     sv = SvRV(sv);
  158.     switch (SvTYPE(sv)) {
  159.     case SVt_PVAV:
  160.     case SVt_PVHV:
  161.     case SVt_PVCV:
  162.         DIE("Not a SCALAR reference");
  163.     }
  164.     }
  165.     else {
  166.     GV *gv = sv;
  167.     char *sym;
  168.  
  169.     if (SvTYPE(gv) != SVt_PVGV) {
  170.         if (SvGMAGICAL(sv)) {
  171.         mg_get(sv);
  172.         if (SvROK(sv))
  173.             goto wasref;
  174.         }
  175.         if (!SvOK(sv)) {
  176.         if (op->op_flags & OPf_REF ||
  177.             op->op_private & HINT_STRICT_REFS)
  178.             DIE(no_usym, "a SCALAR");
  179.         RETSETUNDEF;
  180.         }
  181.         sym = SvPV(sv, na);
  182.         if (op->op_private & HINT_STRICT_REFS)
  183.         DIE(no_symref, sym, "a SCALAR");
  184.         gv = (SV*)gv_fetchpv(sym, TRUE, SVt_PV);
  185.     }
  186.     sv = GvSV(gv);
  187.     }
  188.     if (op->op_flags & OPf_MOD) {
  189.     if (op->op_private & OPpLVAL_INTRO)
  190.         sv = save_scalar((GV*)TOPs);
  191.     else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
  192.         provide_ref(op, sv);
  193.     }
  194.     SETs(sv);
  195.     RETURN;
  196. }
  197.  
  198. PP(pp_av2arylen)
  199. {
  200.     dSP;
  201.     AV *av = (AV*)TOPs;
  202.     SV *sv = AvARYLEN(av);
  203.     if (!sv) {
  204.     AvARYLEN(av) = sv = NEWSV(0,0);
  205.     sv_upgrade(sv, SVt_IV);
  206.     sv_magic(sv, (SV*)av, '#', Nullch, 0);
  207.     }
  208.     SETs(sv);
  209.     RETURN;
  210. }
  211.  
  212. PP(pp_pos)
  213. {
  214.     dSP; dTARGET; dPOPss;
  215.     
  216.     if (op->op_flags & OPf_MOD) {
  217.     LvTYPE(TARG) = '<';
  218.     LvTARG(TARG) = sv;
  219.     PUSHs(TARG);    /* no SvSETMAGIC */
  220.     RETURN;
  221.     }
  222.     else {
  223.     MAGIC* mg; 
  224.  
  225.     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
  226.         mg = mg_find(sv, 'g');
  227.         if (mg && mg->mg_len >= 0) {
  228.         PUSHi(mg->mg_len + curcop->cop_arybase);
  229.         RETURN;
  230.         }
  231.     }
  232.     RETPUSHUNDEF;
  233.     }
  234. }
  235.  
  236. PP(pp_rv2cv)
  237. {
  238.     dSP;
  239.     GV *gv;
  240.     HV *stash;
  241.  
  242.     /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
  243.     /* (But not in defined().) */
  244.     CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL));
  245.  
  246.     if (!cv)
  247.     cv = (CV*)&sv_undef;
  248.     SETs((SV*)cv);
  249.     RETURN;
  250. }
  251.  
  252. PP(pp_prototype)
  253. {
  254.     dSP;
  255.     CV *cv;
  256.     HV *stash;
  257.     GV *gv;
  258.     SV *ret;
  259.  
  260.     ret = &sv_undef;
  261.     cv = sv_2cv(TOPs, &stash, &gv, FALSE);
  262.     if (cv && SvPOK(cv)) {
  263.     char *p = SvPVX(cv);
  264.     ret = sv_2mortal(newSVpv(p ? p : "", SvLEN(cv)));
  265.     }
  266.     SETs(ret);
  267.     RETURN;
  268. }
  269.  
  270. PP(pp_anoncode)
  271. {
  272.     dSP;
  273.     CV* cv = (CV*)cSVOP->op_sv;
  274.     EXTEND(SP,1);
  275.  
  276.     if (CvCLONE(cv))
  277.     cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
  278.  
  279.     PUSHs((SV*)cv);
  280.     RETURN;
  281. }
  282.  
  283. PP(pp_srefgen)
  284. {
  285.     dSP; dTOPss;
  286.     SV* rv;
  287.     rv = sv_newmortal();
  288.     sv_upgrade(rv, SVt_RV);
  289.     if (SvPADTMP(sv))
  290.     sv = newSVsv(sv);
  291.     else {
  292.     SvTEMP_off(sv);
  293.     (void)SvREFCNT_inc(sv);
  294.     }
  295.     SvRV(rv) = sv;
  296.     SvROK_on(rv);
  297.     SETs(rv);
  298.     RETURN;
  299. } 
  300.  
  301. PP(pp_refgen)
  302. {
  303.     dSP; dMARK;
  304.     SV* sv;
  305.     SV* rv;
  306.     if (GIMME != G_ARRAY) {
  307.     MARK[1] = *SP;
  308.     SP = MARK + 1;
  309.     }
  310.     while (MARK < SP) {
  311.     sv = *++MARK;
  312.     rv = sv_newmortal();
  313.     sv_upgrade(rv, SVt_RV);
  314.     if (SvPADTMP(sv))
  315.         sv = newSVsv(sv);
  316.     else {
  317.         SvTEMP_off(sv);
  318.         (void)SvREFCNT_inc(sv);
  319.     }
  320.     SvRV(rv) = sv;
  321.     SvROK_on(rv);
  322.     *MARK = rv;
  323.     }
  324.     RETURN;
  325. }
  326.  
  327. PP(pp_ref)
  328. {
  329.     dSP; dTARGET;
  330.     SV *sv;
  331.     char *pv;
  332.  
  333.     sv = POPs;
  334.     if (!sv || !SvROK(sv))
  335.     RETPUSHNO;
  336.  
  337.     sv = SvRV(sv);
  338.     pv = sv_reftype(sv,TRUE);
  339.     PUSHp(pv, strlen(pv));
  340.     RETURN;
  341. }
  342.  
  343. PP(pp_bless)
  344. {
  345.     dSP;
  346.     HV *stash;
  347.  
  348.     if (MAXARG == 1)
  349.     stash = curcop->cop_stash;
  350.     else
  351.     stash = gv_stashsv(POPs, TRUE);
  352.  
  353.     (void)sv_bless(TOPs, stash);
  354.     RETURN;
  355. }
  356.  
  357. /* Pattern matching */
  358.  
  359. PP(pp_study)
  360. {
  361.     dSP; dPOPss;
  362.     register unsigned char *s;
  363.     register I32 pos;
  364.     register I32 ch;
  365.     register I32 *sfirst;
  366.     register I32 *snext;
  367.     I32 retval;
  368.     STRLEN len;
  369.  
  370.     s = (unsigned char*)(SvPV(sv, len));
  371.     pos = len;
  372.     if (sv == lastscream)
  373.     SvSCREAM_off(sv);
  374.     else {
  375.     if (lastscream) {
  376.         SvSCREAM_off(lastscream);
  377.         SvREFCNT_dec(lastscream);
  378.     }
  379.     lastscream = SvREFCNT_inc(sv);
  380.     }
  381.     if (pos <= 0) {
  382.     retval = 0;
  383.     goto ret;
  384.     }
  385.     if (pos > maxscream) {
  386.     if (maxscream < 0) {
  387.         maxscream = pos + 80;
  388.         New(301, screamfirst, 256, I32);
  389.         New(302, screamnext, maxscream, I32);
  390.     }
  391.     else {
  392.         maxscream = pos + pos / 4;
  393.         Renew(screamnext, maxscream, I32);
  394.     }
  395.     }
  396.  
  397.     sfirst = screamfirst;
  398.     snext = screamnext;
  399.  
  400.     if (!sfirst || !snext)
  401.     DIE("do_study: out of memory");
  402.  
  403.     for (ch = 256; ch; --ch)
  404.     *sfirst++ = -1;
  405.     sfirst -= 256;
  406.  
  407.     while (--pos >= 0) {
  408.     ch = s[pos];
  409.     if (sfirst[ch] >= 0)
  410.         snext[pos] = sfirst[ch] - pos;
  411.     else
  412.         snext[pos] = -pos;
  413.     sfirst[ch] = pos;
  414.  
  415.     /* If there were any case insensitive searches, we must assume they
  416.      * all are.  This speeds up insensitive searches much more than
  417.      * it slows down sensitive ones.
  418.      */
  419.     if (sawi)
  420.         sfirst[fold[ch]] = pos;
  421.     }
  422.  
  423.     SvSCREAM_on(sv);
  424.     sv_magic(sv, Nullsv, 'g', Nullch, 0);    /* piggyback on m//g magic */
  425.     retval = 1;
  426.   ret:
  427.     XPUSHs(sv_2mortal(newSViv((I32)retval)));
  428.     RETURN;
  429. }
  430.  
  431. PP(pp_trans)
  432. {
  433.     dSP; dTARG;
  434.     SV *sv;
  435.  
  436.     if (op->op_flags & OPf_STACKED)
  437.     sv = POPs;
  438.     else {
  439.     sv = GvSV(defgv);
  440.     EXTEND(SP,1);
  441.     }
  442.     TARG = sv_newmortal();
  443.     PUSHi(do_trans(sv, op));
  444.     RETURN;
  445. }
  446.  
  447. /* Lvalue operators. */
  448.  
  449. PP(pp_schop)
  450. {
  451.     dSP; dTARGET;
  452.     do_chop(TARG, TOPs);
  453.     SETTARG;
  454.     RETURN;
  455. }
  456.  
  457. PP(pp_chop)
  458. {
  459.     dSP; dMARK; dTARGET;
  460.     while (SP > MARK)
  461.     do_chop(TARG, POPs);
  462.     PUSHTARG;
  463.     RETURN;
  464. }
  465.  
  466. PP(pp_schomp)
  467. {
  468.     dSP; dTARGET;
  469.     SETi(do_chomp(TOPs));
  470.     RETURN;
  471. }
  472.  
  473. PP(pp_chomp)
  474. {
  475.     dSP; dMARK; dTARGET;
  476.     register I32 count = 0;
  477.     
  478.     while (SP > MARK)
  479.     count += do_chomp(POPs);
  480.     PUSHi(count);
  481.     RETURN;
  482. }
  483.  
  484. PP(pp_defined)
  485. {
  486.     dSP;
  487.     register SV* sv;
  488.  
  489.     sv = POPs;
  490.     if (!sv || !SvANY(sv))
  491.     RETPUSHNO;
  492.     switch (SvTYPE(sv)) {
  493.     case SVt_PVAV:
  494.     if (AvMAX(sv) >= 0 || SvRMAGICAL(sv))
  495.         RETPUSHYES;
  496.     break;
  497.     case SVt_PVHV:
  498.     if (HvARRAY(sv) || SvRMAGICAL(sv))
  499.         RETPUSHYES;
  500.     break;
  501.     case SVt_PVCV:
  502.     if (CvROOT(sv) || CvXSUB(sv))
  503.         RETPUSHYES;
  504.     break;
  505.     default:
  506.     if (SvGMAGICAL(sv))
  507.         mg_get(sv);
  508.     if (SvOK(sv))
  509.         RETPUSHYES;
  510.     }
  511.     RETPUSHNO;
  512. }
  513.  
  514. PP(pp_undef)
  515. {
  516.     dSP;
  517.     SV *sv;
  518.  
  519.     if (!op->op_private)
  520.     RETPUSHUNDEF;
  521.  
  522.     sv = POPs;
  523.     if (!sv)
  524.     RETPUSHUNDEF;
  525.  
  526.     if (SvTHINKFIRST(sv)) {
  527.     if (SvREADONLY(sv))
  528.         RETPUSHUNDEF;
  529.     if (SvROK(sv))
  530.         sv_unref(sv);
  531.     }
  532.  
  533.     switch (SvTYPE(sv)) {
  534.     case SVt_NULL:
  535.     break;
  536.     case SVt_PVAV:
  537.     av_undef((AV*)sv);
  538.     break;
  539.     case SVt_PVHV:
  540.     hv_undef((HV*)sv);
  541.     break;
  542.     case SVt_PVCV:
  543.     cv_undef((CV*)sv);
  544.     sub_generation++;
  545.     break;
  546.     case SVt_PVGV:
  547.         if (SvFAKE(sv)) {
  548.             sv_setsv(sv, &sv_undef);
  549.             break;
  550.         }
  551.     default:
  552.     if (SvPOK(sv) && SvLEN(sv)) {
  553.         (void)SvOOK_off(sv);
  554.         Safefree(SvPVX(sv));
  555.         SvPV_set(sv, Nullch);
  556.         SvLEN_set(sv, 0);
  557.     }
  558.     (void)SvOK_off(sv);
  559.     SvSETMAGIC(sv);
  560.     }
  561.  
  562.     RETPUSHUNDEF;
  563. }
  564.  
  565. PP(pp_predec)
  566. {
  567.     dSP;
  568.     if (SvIOK(TOPs)) {
  569.     --SvIVX(TOPs);
  570.     SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
  571.     }
  572.     else
  573.     sv_dec(TOPs);
  574.     SvSETMAGIC(TOPs);
  575.     return NORMAL;
  576. }
  577.  
  578. PP(pp_postinc)
  579. {
  580.     dSP; dTARGET;
  581.     sv_setsv(TARG, TOPs);
  582.     if (SvIOK(TOPs)) {
  583.     ++SvIVX(TOPs);
  584.     SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
  585.     }
  586.     else
  587.     sv_inc(TOPs);
  588.     SvSETMAGIC(TOPs);
  589.     if (!SvOK(TARG))
  590.     sv_setiv(TARG, 0);
  591.     SETs(TARG);
  592.     return NORMAL;
  593. }
  594.  
  595. PP(pp_postdec)
  596. {
  597.     dSP; dTARGET;
  598.     sv_setsv(TARG, TOPs);
  599.     if (SvIOK(TOPs)) {
  600.     --SvIVX(TOPs);
  601.     SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
  602.     }
  603.     else
  604.     sv_dec(TOPs);
  605.     SvSETMAGIC(TOPs);
  606.     SETs(TARG);
  607.     return NORMAL;
  608. }
  609.  
  610. /* Ordinary operators. */
  611.  
  612. #ifdef macintosh
  613. /* Eeevil headers define pow as powd */
  614. #define powd_amg     pow_amg
  615. #define atan2d_amg    atan2_amg
  616. #define sind_amg     sin_amg
  617. #define cosd_amg     cos_amg
  618. #define expd_amg     exp_amg
  619. #define logd_amg     log_amg
  620. #define sqrtd_amg     sqrt_amg
  621. #endif
  622.  
  623. PP(pp_pow)
  624. {
  625.     dSP; dATARGET; tryAMAGICbin(pow,opASSIGN); 
  626.     {
  627.       dPOPTOPnnrl;
  628.       SETn( pow( left, right) );
  629.       RETURN;
  630.     }
  631. }
  632.  
  633. PP(pp_multiply)
  634. {
  635.     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); 
  636.     {
  637.       dPOPTOPnnrl;
  638.       SETn( left * right );
  639.       RETURN;
  640.     }
  641. }
  642.  
  643. PP(pp_divide)
  644. {
  645.     dSP; dATARGET; tryAMAGICbin(div,opASSIGN); 
  646.     {
  647.       dPOPnv;
  648.       if (value == 0.0)
  649.     DIE("Illegal division by zero");
  650. #ifdef SLOPPYDIVIDE
  651.       /* insure that 20./5. == 4. */
  652.       {
  653.     double x;
  654.     I32    k;
  655.     x =  POPn;
  656.     if ((double)I_32(x)     == x &&
  657.         (double)I_32(value) == value &&
  658.         (k = I_32(x)/I_32(value))*I_32(value) == I_32(x)) {
  659.         value = k;
  660.     } else {
  661.         value = x/value;
  662.     }
  663.       }
  664. #else
  665.       value = POPn / value;
  666. #endif
  667.       PUSHn( value );
  668.       RETURN;
  669.     }
  670. }
  671.  
  672. PP(pp_modulo)
  673. {
  674.     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
  675.     {
  676.       register unsigned long tmpulong;
  677.       register long tmplong;
  678.       I32 value;
  679.  
  680.       tmpulong = (unsigned long) POPn;
  681.       if (tmpulong == 0L)
  682.     DIE("Illegal modulus zero");
  683.       value = TOPn;
  684.       if (value >= 0.0)
  685.     value = (I32)(((unsigned long)value) % tmpulong);
  686.       else {
  687.     tmplong = (long)value;
  688.     value = (I32)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
  689.       }
  690.       SETi(value);
  691.       RETURN;
  692.     }
  693. }
  694.  
  695. PP(pp_repeat)
  696. {
  697.   dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
  698.   {
  699.     register I32 count = POPi;
  700.     if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
  701.     dMARK;
  702.     I32 items = SP - MARK;
  703.     I32 max;
  704.  
  705.     max = items * count;
  706.     MEXTEND(MARK, max);
  707.     if (count > 1) {
  708.         while (SP > MARK) {
  709.         if (*SP)
  710.             SvTEMP_off((*SP));
  711.         SP--;
  712.         }
  713.         MARK++;
  714.         repeatcpy((char*)(MARK + items), (char*)MARK,
  715.         items * sizeof(SV*), count - 1);
  716.         SP += max;
  717.     }
  718.     else if (count <= 0)
  719.         SP -= items;
  720.     }
  721.     else {    /* Note: mark already snarfed by pp_list */
  722.     SV *tmpstr;
  723.     STRLEN len;
  724.  
  725.     tmpstr = POPs;
  726.     if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
  727.         if (SvREADONLY(tmpstr) && curcop != &compiling)
  728.         DIE("Can't x= to readonly value");
  729.         if (SvROK(tmpstr))
  730.         sv_unref(tmpstr);
  731.     }
  732.     SvSetSV(TARG, tmpstr);
  733.     SvPV_force(TARG, len);
  734.     if (count >= 1) {
  735.         SvGROW(TARG, (count * len) + 1);
  736.         if (count > 1)
  737.         repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
  738.         SvCUR(TARG) *= count;
  739.         *SvEND(TARG) = '\0';
  740.         (void)SvPOK_only(TARG);
  741.     }
  742.     else
  743.         sv_setsv(TARG, &sv_no);
  744.     PUSHTARG;
  745.     }
  746.     RETURN;
  747.   }
  748. }
  749.  
  750. PP(pp_subtract)
  751. {
  752.     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); 
  753.     {
  754.       dPOPTOPnnrl;
  755.       SETn( left - right );
  756.       RETURN;
  757.     }
  758. }
  759.  
  760. PP(pp_left_shift)
  761. {
  762.     dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); 
  763.     {
  764.         dPOPTOPiirl;
  765.         SETi( left << right );
  766.         RETURN;
  767.     }
  768. }
  769.  
  770. PP(pp_right_shift)
  771. {
  772.     dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); 
  773.     {
  774.       dPOPTOPiirl;
  775.       SETi( left >> right );
  776.       RETURN;
  777.     }
  778. }
  779.  
  780. PP(pp_lt)
  781. {
  782.     dSP; tryAMAGICbinSET(lt,0); 
  783.     {
  784.       dPOPnv;
  785.       SETs((TOPn < value) ? &sv_yes : &sv_no);
  786.       RETURN;
  787.     }
  788. }
  789.  
  790. PP(pp_gt)
  791. {
  792.     dSP; tryAMAGICbinSET(gt,0); 
  793.     {
  794.       dPOPnv;
  795.       SETs((TOPn > value) ? &sv_yes : &sv_no);
  796.       RETURN;
  797.     }
  798. }
  799.  
  800. PP(pp_le)
  801. {
  802.     dSP; tryAMAGICbinSET(le,0); 
  803.     {
  804.       dPOPnv;
  805.       SETs((TOPn <= value) ? &sv_yes : &sv_no);
  806.       RETURN;
  807.     }
  808. }
  809.  
  810. PP(pp_ge)
  811. {
  812.     dSP; tryAMAGICbinSET(ge,0); 
  813.     {
  814.       dPOPnv;
  815.       SETs((TOPn >= value) ? &sv_yes : &sv_no);
  816.       RETURN;
  817.     }
  818. }
  819.  
  820. PP(pp_ne)
  821. {
  822.     dSP; tryAMAGICbinSET(ne,0); 
  823.     {
  824.       dPOPnv;
  825.       SETs((TOPn != value) ? &sv_yes : &sv_no);
  826.       RETURN;
  827.     }
  828. }
  829.  
  830. PP(pp_ncmp)
  831. {
  832.     dSP; dTARGET; tryAMAGICbin(ncmp,0); 
  833.     {
  834.       dPOPTOPnnrl;
  835.       I32 value;
  836.  
  837.       if (left > right)
  838.     value = 1;
  839.       else if (left < right)
  840.     value = -1;
  841.       else
  842.     value = 0;
  843.       SETi(value);
  844.       RETURN;
  845.     }
  846. }
  847.  
  848. PP(pp_slt)
  849. {
  850.     dSP; tryAMAGICbinSET(slt,0); 
  851.     {
  852.       dPOPTOPssrl;
  853.       SETs( sv_cmp(left, right) < 0 ? &sv_yes : &sv_no );
  854.       RETURN;
  855.     }
  856. }
  857.  
  858. PP(pp_sgt)
  859. {
  860.     dSP; tryAMAGICbinSET(sgt,0); 
  861.     {
  862.       dPOPTOPssrl;
  863.       SETs( sv_cmp(left, right) > 0 ? &sv_yes : &sv_no );
  864.       RETURN;
  865.     }
  866. }
  867.  
  868. PP(pp_sle)
  869. {
  870.     dSP; tryAMAGICbinSET(sle,0); 
  871.     {
  872.       dPOPTOPssrl;
  873.       SETs( sv_cmp(left, right) <= 0 ? &sv_yes : &sv_no );
  874.       RETURN;
  875.     }
  876. }
  877.  
  878. PP(pp_sge)
  879. {
  880.     dSP; tryAMAGICbinSET(sge,0); 
  881.     {
  882.       dPOPTOPssrl;
  883.       SETs( sv_cmp(left, right) >= 0 ? &sv_yes : &sv_no );
  884.       RETURN;
  885.     }
  886. }
  887.  
  888. PP(pp_sne)
  889. {
  890.     dSP; tryAMAGICbinSET(sne,0); 
  891.     {
  892.       dPOPTOPssrl;
  893.       SETs( !sv_eq(left, right) ? &sv_yes : &sv_no );
  894.       RETURN;
  895.     }
  896. }
  897.  
  898. PP(pp_scmp)
  899. {
  900.     dSP; dTARGET;  tryAMAGICbin(scmp,0);
  901.     {
  902.       dPOPTOPssrl;
  903.       SETi( sv_cmp(left, right) );
  904.       RETURN;
  905.     }
  906. }
  907.  
  908. PP(pp_bit_and) {
  909.     dSP; dATARGET; tryAMAGICbin(band,opASSIGN); 
  910.     {
  911.       dPOPTOPssrl;
  912.       if (SvNIOKp(left) || SvNIOKp(right)) {
  913.     unsigned long value = U_L(SvNV(left));
  914.     value = value & U_L(SvNV(right));
  915.     SETn((double)value);
  916.       }
  917.       else {
  918.     do_vop(op->op_type, TARG, left, right);
  919.     SETTARG;
  920.       }
  921.       RETURN;
  922.     }
  923. }
  924.  
  925. PP(pp_bit_xor)
  926. {
  927.     dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); 
  928.     {
  929.       dPOPTOPssrl;
  930.       if (SvNIOKp(left) || SvNIOKp(right)) {
  931.     unsigned long value = U_L(SvNV(left));
  932.     value = value ^ U_L(SvNV(right));
  933.     SETn((double)value);
  934.       }
  935.       else {
  936.     do_vop(op->op_type, TARG, left, right);
  937.     SETTARG;
  938.       }
  939.       RETURN;
  940.     }
  941. }
  942.  
  943. PP(pp_bit_or)
  944. {
  945.     dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); 
  946.     {
  947.       dPOPTOPssrl;
  948.       if (SvNIOKp(left) || SvNIOKp(right)) {
  949.     unsigned long value = U_L(SvNV(left));
  950.     value = value | U_L(SvNV(right));
  951.     SETn((double)value);
  952.       }
  953.       else {
  954.     do_vop(op->op_type, TARG, left, right);
  955.     SETTARG;
  956.       }
  957.       RETURN;
  958.     }
  959. }
  960.  
  961. PP(pp_negate)
  962. {
  963.     dSP; dTARGET; tryAMAGICun(neg);
  964.     {
  965.     dTOPss;
  966.     if (SvGMAGICAL(sv))
  967.         mg_get(sv);
  968.     if (SvNIOKp(sv))
  969.         SETn(-SvNV(sv));
  970.     else if (SvPOKp(sv)) {
  971.         STRLEN len;
  972.         char *s = SvPV(sv, len);
  973.         if (isALPHA(*s) || *s == '_') {
  974.         sv_setpvn(TARG, "-", 1);
  975.         sv_catsv(TARG, sv);
  976.         }
  977.         else if (*s == '+' || *s == '-') {
  978.         sv_setsv(TARG, sv);
  979.         *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
  980.         }
  981.         else
  982.         sv_setnv(TARG, -SvNV(sv));
  983.         SETTARG;
  984.     }
  985.     else
  986.         SETn(-SvNV(sv));
  987.     }
  988.     RETURN;
  989. }
  990.  
  991. PP(pp_not)
  992. {
  993. #ifdef OVERLOAD
  994.     dSP; tryAMAGICunSET(not);
  995. #endif /* OVERLOAD */
  996.     *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes;
  997.     return NORMAL;
  998. }
  999.  
  1000. PP(pp_complement)
  1001. {
  1002.     dSP; dTARGET; tryAMAGICun(compl); 
  1003.     {
  1004.       dTOPss;
  1005.       register I32 anum;
  1006.  
  1007.       if (SvNIOKp(sv)) {
  1008.     IV iv = ~SvIV(sv);
  1009.     if (iv < 0)
  1010.         SETn( (double) ~U_L(SvNV(sv)) );
  1011.     else
  1012.         SETi( iv );
  1013.       }
  1014.       else {
  1015.     register char *tmps;
  1016.     register long *tmpl;
  1017.     STRLEN len;
  1018.  
  1019.     SvSetSV(TARG, sv);
  1020.     tmps = SvPV_force(TARG, len);
  1021.     anum = len;
  1022. #ifdef LIBERAL
  1023.     for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
  1024.         *tmps = ~*tmps;
  1025.     tmpl = (long*)tmps;
  1026.     for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
  1027.         *tmpl = ~*tmpl;
  1028.     tmps = (char*)tmpl;
  1029. #endif
  1030.     for ( ; anum > 0; anum--, tmps++)
  1031.         *tmps = ~*tmps;
  1032.  
  1033.     SETs(TARG);
  1034.       }
  1035.       RETURN;
  1036.     }
  1037. }
  1038.  
  1039. /* integer versions of some of the above */
  1040.  
  1041. PP(pp_i_multiply)
  1042. {
  1043.     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); 
  1044.     {
  1045.       dPOPTOPiirl;
  1046.       SETi( left * right );
  1047.       RETURN;
  1048.     }
  1049. }
  1050.  
  1051. PP(pp_i_divide)
  1052. {
  1053.     dSP; dATARGET; tryAMAGICbin(div,opASSIGN); 
  1054.     {
  1055.       dPOPiv;
  1056.       if (value == 0)
  1057.     DIE("Illegal division by zero");
  1058.       value = POPi / value;
  1059.       PUSHi( value );
  1060.       RETURN;
  1061.     }
  1062. }
  1063.  
  1064. PP(pp_i_modulo)
  1065. {
  1066.     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN); 
  1067.     {
  1068.       dPOPTOPiirl;
  1069.       SETi( left % right );
  1070.       RETURN;
  1071.     }
  1072. }
  1073.  
  1074. PP(pp_i_add)
  1075. {
  1076.     dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
  1077.     {
  1078.       dPOPTOPiirl;
  1079.       SETi( left + right );
  1080.       RETURN;
  1081.     }
  1082. }
  1083.  
  1084. PP(pp_i_subtract)
  1085. {
  1086.     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); 
  1087.     {
  1088.       dPOPTOPiirl;
  1089.       SETi( left - right );
  1090.       RETURN;
  1091.     }
  1092. }
  1093.  
  1094. PP(pp_i_lt)
  1095. {
  1096.     dSP; tryAMAGICbinSET(lt,0); 
  1097.     {
  1098.       dPOPTOPiirl;
  1099.       SETs((left < right) ? &sv_yes : &sv_no);
  1100.       RETURN;
  1101.     }
  1102. }
  1103.  
  1104. PP(pp_i_gt)
  1105. {
  1106.     dSP; tryAMAGICbinSET(gt,0); 
  1107.     {
  1108.       dPOPTOPiirl;
  1109.       SETs((left > right) ? &sv_yes : &sv_no);
  1110.       RETURN;
  1111.     }
  1112. }
  1113.  
  1114. PP(pp_i_le)
  1115. {
  1116.     dSP; tryAMAGICbinSET(le,0); 
  1117.     {
  1118.       dPOPTOPiirl;
  1119.       SETs((left <= right) ? &sv_yes : &sv_no);
  1120.       RETURN;
  1121.     }
  1122. }
  1123.  
  1124. PP(pp_i_ge)
  1125. {
  1126.     dSP; tryAMAGICbinSET(ge,0); 
  1127.     {
  1128.       dPOPTOPiirl;
  1129.       SETs((left >= right) ? &sv_yes : &sv_no);
  1130.       RETURN;
  1131.     }
  1132. }
  1133.  
  1134. PP(pp_i_eq)
  1135. {
  1136.     dSP; tryAMAGICbinSET(eq,0); 
  1137.     {
  1138.       dPOPTOPiirl;
  1139.       SETs((left == right) ? &sv_yes : &sv_no);
  1140.       RETURN;
  1141.     }
  1142. }
  1143.  
  1144. PP(pp_i_ne)
  1145. {
  1146.     dSP; tryAMAGICbinSET(ne,0); 
  1147.     {
  1148.       dPOPTOPiirl;
  1149.       SETs((left != right) ? &sv_yes : &sv_no);
  1150.       RETURN;
  1151.     }
  1152. }
  1153.  
  1154. PP(pp_i_ncmp)
  1155. {
  1156.     dSP; dTARGET; tryAMAGICbin(ncmp,0); 
  1157.     {
  1158.       dPOPTOPiirl;
  1159.       I32 value;
  1160.  
  1161.       if (left > right)
  1162.     value = 1;
  1163.       else if (left < right)
  1164.     value = -1;
  1165.       else
  1166.     value = 0;
  1167.       SETi(value);
  1168.       RETURN;
  1169.     }
  1170. }
  1171.  
  1172. PP(pp_i_negate)
  1173. {
  1174.     dSP; dTARGET; tryAMAGICun(neg);
  1175.     SETi(-TOPi);
  1176.     RETURN;
  1177. }
  1178.  
  1179. /* High falutin' math. */
  1180.  
  1181. PP(pp_atan2)
  1182. {
  1183.     dSP; dTARGET; tryAMAGICbin(atan2,0); 
  1184.     {
  1185.       dPOPTOPnnrl;
  1186.       SETn(atan2(left, right));
  1187.       RETURN;
  1188.     }
  1189. }
  1190.  
  1191. PP(pp_sin)
  1192. {
  1193.     dSP; dTARGET; tryAMAGICun(sin);
  1194.     {
  1195.       double value;
  1196.       value = POPn;
  1197.       value = sin(value);
  1198.       XPUSHn(value);
  1199.       RETURN;
  1200.     }
  1201. }
  1202.  
  1203. PP(pp_cos)
  1204. {
  1205.     dSP; dTARGET; tryAMAGICun(cos);
  1206.     {
  1207.       double value;
  1208.       value = POPn;
  1209.       value = cos(value);
  1210.       XPUSHn(value);
  1211.       RETURN;
  1212.     }
  1213. }
  1214.  
  1215. PP(pp_rand)
  1216. {
  1217.     dSP; dTARGET;
  1218.     double value;
  1219.     if (MAXARG < 1)
  1220.     value = 1.0;
  1221.     else
  1222.     value = POPn;
  1223.     if (value == 0.0)
  1224.     value = 1.0;
  1225. #if RANDBITS == 31
  1226.     value = rand() * value / 2147483648.0;
  1227. #else
  1228. #if RANDBITS == 16
  1229.     value = rand() * value / 65536.0;
  1230. #else
  1231. #if RANDBITS == 15
  1232.     value = rand() * value / 32768.0;
  1233. #else
  1234.     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
  1235. #endif
  1236. #endif
  1237. #endif
  1238.     XPUSHn(value);
  1239.     RETURN;
  1240. }
  1241.  
  1242. PP(pp_srand)
  1243. {
  1244.     dSP;
  1245.     I32 anum;
  1246.     Time_t when;
  1247.  
  1248.     if (MAXARG < 1) {
  1249.     (void)time(&when);
  1250.     anum = when;
  1251.     }
  1252.     else
  1253.     anum = POPi;
  1254.     (void)srand(anum);
  1255.     EXTEND(SP, 1);
  1256.     RETPUSHYES;
  1257. }
  1258.  
  1259. PP(pp_exp)
  1260. {
  1261.     dSP; dTARGET; tryAMAGICun(exp);
  1262.     {
  1263.       double value;
  1264.       value = POPn;
  1265.       value = exp(value);
  1266.       XPUSHn(value);
  1267.       RETURN;
  1268.     }
  1269. }
  1270.  
  1271. PP(pp_log)
  1272. {
  1273.     dSP; dTARGET; tryAMAGICun(log);
  1274.     {
  1275.       double value;
  1276.       value = POPn;
  1277.       if (value <= 0.0)
  1278.     DIE("Can't take log of %g", value);
  1279.       value = log(value);
  1280.       XPUSHn(value);
  1281.       RETURN;
  1282.     }
  1283. }
  1284.  
  1285. PP(pp_sqrt)
  1286. {
  1287.     dSP; dTARGET; tryAMAGICun(sqrt);
  1288.     {
  1289.       double value;
  1290.       value = POPn;
  1291.       if (value < 0.0)
  1292.     DIE("Can't take sqrt of %g", value);
  1293.       value = sqrt(value);
  1294.       XPUSHn(value);
  1295.       RETURN;
  1296.     }
  1297. }
  1298.  
  1299. PP(pp_int)
  1300. {
  1301.     dSP; dTARGET;
  1302. #if defined(macintosh) && !defined(powerc) && !defined(_powerc) && !defined(__MWERKS__)
  1303.     extended value;
  1304. #else
  1305.     double value;
  1306. #endif
  1307.     value = POPn;
  1308.     if (value >= 0.0)
  1309.     (void)modf(value, &value);
  1310.     else {
  1311.     (void)modf(-value, &value);
  1312.     value = -value;
  1313.     }
  1314.     XPUSHn(value);
  1315.     RETURN;
  1316. }
  1317.  
  1318. PP(pp_abs)
  1319. {
  1320.     dSP; dTARGET; tryAMAGICun(abs);
  1321.     {
  1322.       double value;
  1323.       value = POPn;
  1324.  
  1325.       if (value < 0.0)
  1326.     value = -value;
  1327.  
  1328.       XPUSHn(value);
  1329.       RETURN;
  1330.     }
  1331. }
  1332.  
  1333. PP(pp_hex)
  1334. {
  1335.     dSP; dTARGET;
  1336.     char *tmps;
  1337.     unsigned long value;
  1338.     I32 argtype;
  1339.  
  1340.     tmps = POPp;
  1341.     value = scan_hex(tmps, 99, &argtype);
  1342.     if ((IV)value >= 0)
  1343.     XPUSHi(value);
  1344.     else
  1345.     XPUSHn(U_V(value));
  1346.     RETURN;
  1347. }
  1348.  
  1349. PP(pp_oct)
  1350. {
  1351.     dSP; dTARGET;
  1352.     unsigned long value;
  1353.     I32 argtype;
  1354.     char *tmps;
  1355.  
  1356.     tmps = POPp;
  1357.     while (*tmps && isSPACE(*tmps))
  1358.     tmps++;
  1359.     if (*tmps == '0')
  1360.     tmps++;
  1361.     if (*tmps == 'x')
  1362.     value = scan_hex(++tmps, 99, &argtype);
  1363.     else
  1364.     value = scan_oct(tmps, 99, &argtype);
  1365.     if ((IV)value >= 0)
  1366.     XPUSHi(value);
  1367.     else
  1368.     XPUSHn(U_V(value));
  1369.     RETURN;
  1370. }
  1371.  
  1372. /* String stuff. */
  1373.  
  1374. PP(pp_length)
  1375. {
  1376.     dSP; dTARGET;
  1377.     SETi( sv_len(TOPs) );
  1378.     RETURN;
  1379. }
  1380.  
  1381. PP(pp_substr)
  1382. {
  1383.     dSP; dTARGET;
  1384.     SV *sv;
  1385.     I32 len;
  1386.     STRLEN curlen;
  1387.     I32 pos;
  1388.     I32 rem;
  1389.     I32 lvalue = op->op_flags & OPf_MOD;
  1390.     char *tmps;
  1391.     I32 arybase = curcop->cop_arybase;
  1392.  
  1393.     if (MAXARG > 2)
  1394.     len = POPi;
  1395.     pos = POPi - arybase;
  1396.     sv = POPs;
  1397.     tmps = SvPV(sv, curlen);
  1398.     if (pos < 0)
  1399.     pos += curlen + arybase;
  1400.     if (pos < 0 || pos > curlen) {
  1401.     if (dowarn || lvalue)
  1402.         warn("substr outside of string");
  1403.     RETPUSHUNDEF;
  1404.     }
  1405.     else {
  1406.     if (MAXARG < 3)
  1407.         len = curlen;
  1408.     else if (len < 0) {
  1409.         len += curlen - pos;
  1410.         if (len < 0)
  1411.         len = 0;
  1412.     }
  1413.     tmps += pos;
  1414.     rem = curlen - pos;    /* rem=how many bytes left*/
  1415.     if (rem > len)
  1416.         rem = len;
  1417.     sv_setpvn(TARG, tmps, rem);
  1418.     if (lvalue) {            /* it's an lvalue! */
  1419.         if (!SvGMAGICAL(sv))
  1420.         (void)SvPOK_only(sv);
  1421.         if (SvTYPE(TARG) < SVt_PVLV) {
  1422.         sv_upgrade(TARG, SVt_PVLV);
  1423.         sv_magic(TARG, Nullsv, 'x', Nullch, 0);
  1424.         }
  1425.  
  1426.         LvTYPE(TARG) = 's';
  1427.         LvTARG(TARG) = sv;
  1428.         LvTARGOFF(TARG) = pos;
  1429.         LvTARGLEN(TARG) = rem; 
  1430.     }
  1431.     }
  1432.     PUSHs(TARG);        /* avoid SvSETMAGIC here */
  1433.     RETURN;
  1434. }
  1435.  
  1436. PP(pp_vec)
  1437. {
  1438.     dSP; dTARGET;
  1439.     register I32 size = POPi;
  1440.     register I32 offset = POPi;
  1441.     register SV *src = POPs;
  1442.     I32 lvalue = op->op_flags & OPf_MOD;
  1443.     STRLEN srclen;
  1444.     unsigned char *s = (unsigned char*)SvPV(src, srclen);
  1445.     unsigned long retnum;
  1446.     I32 len;
  1447.  
  1448.     offset *= size;        /* turn into bit offset */
  1449.     len = (offset + size + 7) / 8;
  1450.     if (offset < 0 || size < 1)
  1451.     retnum = 0;
  1452.     else {
  1453.     if (lvalue) {                      /* it's an lvalue! */
  1454.         if (SvTYPE(TARG) < SVt_PVLV) {
  1455.         sv_upgrade(TARG, SVt_PVLV);
  1456.         sv_magic(TARG, Nullsv, 'v', Nullch, 0);
  1457.         }
  1458.  
  1459.         LvTYPE(TARG) = 'v';
  1460.         LvTARG(TARG) = src;
  1461.         LvTARGOFF(TARG) = offset; 
  1462.         LvTARGLEN(TARG) = size; 
  1463.     }
  1464.     if (len > srclen) {
  1465.         if (size <= 8)
  1466.         retnum = 0;
  1467.         else {
  1468.         offset >>= 3;
  1469.         if (size == 16) {
  1470.             if (offset >= srclen)
  1471.             retnum = 0;
  1472.             else
  1473.             retnum = (unsigned long) s[offset] << 8;
  1474.         }
  1475.         else if (size == 32) {
  1476.             if (offset >= srclen)
  1477.             retnum = 0;
  1478.             else if (offset + 1 >= srclen)
  1479.             retnum = (unsigned long) s[offset] << 24;
  1480.             else if (offset + 2 >= srclen)
  1481.             retnum = ((unsigned long) s[offset] << 24) +
  1482.                 ((unsigned long) s[offset + 1] << 16);
  1483.             else
  1484.             retnum = ((unsigned long) s[offset] << 24) +
  1485.                 ((unsigned long) s[offset + 1] << 16) +
  1486.                 (s[offset + 2] << 8);
  1487.         }
  1488.         }
  1489.     }
  1490.     else if (size < 8)
  1491.         retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
  1492.     else {
  1493.         offset >>= 3;
  1494.         if (size == 8)
  1495.         retnum = s[offset];
  1496.         else if (size == 16)
  1497.         retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
  1498.         else if (size == 32)
  1499.         retnum = ((unsigned long) s[offset] << 24) +
  1500.             ((unsigned long) s[offset + 1] << 16) +
  1501.             (s[offset + 2] << 8) + s[offset+3];
  1502.     }
  1503.     }
  1504.  
  1505.     sv_setiv(TARG, (I32)retnum);
  1506.     PUSHs(TARG);
  1507.     RETURN;
  1508. }
  1509.  
  1510. PP(pp_index)
  1511. {
  1512.     dSP; dTARGET;
  1513.     SV *big;
  1514.     SV *little;
  1515.     I32 offset;
  1516.     I32 retval;
  1517.     char *tmps;
  1518.     char *tmps2;
  1519.     STRLEN biglen;
  1520.     I32 arybase = curcop->cop_arybase;
  1521.  
  1522.     if (MAXARG < 3)
  1523.     offset = 0;
  1524.     else
  1525.     offset = POPi - arybase;
  1526.     little = POPs;
  1527.     big = POPs;
  1528.     tmps = SvPV(big, biglen);
  1529.     if (offset < 0)
  1530.     offset = 0;
  1531.     else if (offset > biglen)
  1532.     offset = biglen;
  1533.     if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
  1534.       (unsigned char*)tmps + biglen, little)))
  1535.     retval = -1 + arybase;
  1536.     else
  1537.     retval = tmps2 - tmps + arybase;
  1538.     PUSHi(retval);
  1539.     RETURN;
  1540. }
  1541.  
  1542. PP(pp_rindex)
  1543. {
  1544.     dSP; dTARGET;
  1545.     SV *big;
  1546.     SV *little;
  1547.     STRLEN blen;
  1548.     STRLEN llen;
  1549.     SV *offstr;
  1550.     I32 offset;
  1551.     I32 retval;
  1552.     char *tmps;
  1553.     char *tmps2;
  1554.     I32 arybase = curcop->cop_arybase;
  1555.  
  1556.     if (MAXARG >= 3)
  1557.     offstr = POPs;
  1558.     little = POPs;
  1559.     big = POPs;
  1560.     tmps2 = SvPV(little, llen);
  1561.     tmps = SvPV(big, blen);
  1562.     if (MAXARG < 3)
  1563.     offset = blen;
  1564.     else
  1565.     offset = SvIV(offstr) - arybase + llen;
  1566.     if (offset < 0)
  1567.     offset = 0;
  1568.     else if (offset > blen)
  1569.     offset = blen;
  1570.     if (!(tmps2 = rninstr(tmps,  tmps  + offset,
  1571.               tmps2, tmps2 + llen)))
  1572.     retval = -1 + arybase;
  1573.     else
  1574.     retval = tmps2 - tmps + arybase;
  1575.     PUSHi(retval);
  1576.     RETURN;
  1577. }
  1578.  
  1579. PP(pp_sprintf)
  1580. {
  1581.     dSP; dMARK; dORIGMARK; dTARGET;
  1582.     do_sprintf(TARG, SP-MARK, MARK+1);
  1583.     SP = ORIGMARK;
  1584.     PUSHTARG;
  1585.     RETURN;
  1586. }
  1587.  
  1588. PP(pp_ord)
  1589. {
  1590.     dSP; dTARGET;
  1591.     I32 value;
  1592.     char *tmps;
  1593.  
  1594. #ifndef I286
  1595.     tmps = POPp;
  1596.     value = (I32) (*tmps & 255);
  1597. #else
  1598.     I32 anum;
  1599.     tmps = POPp;
  1600.     anum = (I32) *tmps;
  1601.     value = (I32) (anum & 255);
  1602. #endif
  1603.     XPUSHi(value);
  1604.     RETURN;
  1605. }
  1606.  
  1607. PP(pp_chr)
  1608. {
  1609.     dSP; dTARGET;
  1610.     char *tmps;
  1611.  
  1612.     (void)SvUPGRADE(TARG,SVt_PV);
  1613.     SvGROW(TARG,2);
  1614.     SvCUR_set(TARG, 1);
  1615.     tmps = SvPVX(TARG);
  1616.     *tmps++ = POPi;
  1617.     *tmps = '\0';
  1618.     (void)SvPOK_only(TARG);
  1619.     XPUSHs(TARG);
  1620.     RETURN;
  1621. }
  1622.  
  1623. PP(pp_crypt)
  1624. {
  1625.     dSP; dTARGET; dPOPTOPssrl;
  1626. #ifdef HAS_CRYPT
  1627.     char *tmps = SvPV(left, na);
  1628. #ifdef FCRYPT
  1629.     sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
  1630. #else
  1631.     sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
  1632. #endif
  1633. #else
  1634.     DIE(
  1635.       "The crypt() function is unimplemented due to excessive paranoia.");
  1636. #endif
  1637.     SETs(TARG);
  1638.     RETURN;
  1639. }
  1640.  
  1641. PP(pp_ucfirst)
  1642. {
  1643.     dSP;
  1644.     SV *sv = TOPs;
  1645.     register char *s;
  1646.  
  1647.     if (!SvPADTMP(sv)) {
  1648.     dTARGET;
  1649.     sv_setsv(TARG, sv);
  1650.     sv = TARG;
  1651.     SETs(sv);
  1652.     }
  1653.     s = SvPV_force(sv, na);
  1654.     if (isLOWER(*s))
  1655.     *s = toUPPER(*s);
  1656.  
  1657.     RETURN;
  1658. }
  1659.  
  1660. PP(pp_lcfirst)
  1661. {
  1662.     dSP;
  1663.     SV *sv = TOPs;
  1664.     register char *s;
  1665.  
  1666.     if (!SvPADTMP(sv)) {
  1667.     dTARGET;
  1668.     sv_setsv(TARG, sv);
  1669.     sv = TARG;
  1670.     SETs(sv);
  1671.     }
  1672.     s = SvPV_force(sv, na);
  1673.     if (isUPPER(*s))
  1674.     *s = toLOWER(*s);
  1675.  
  1676.     SETs(sv);
  1677.     RETURN;
  1678. }
  1679.  
  1680. PP(pp_uc)
  1681. {
  1682.     dSP;
  1683.     SV *sv = TOPs;
  1684.     register char *s;
  1685.     register char *send;
  1686.     STRLEN len;
  1687.  
  1688.     if (!SvPADTMP(sv)) {
  1689.     dTARGET;
  1690.     sv_setsv(TARG, sv);
  1691.     sv = TARG;
  1692.     SETs(sv);
  1693.     }
  1694.     s = SvPV_force(sv, len);
  1695.     send = s + len;
  1696.     while (s < send) {
  1697.     if (isLOWER(*s))
  1698.         *s = toUPPER(*s);
  1699.     s++;
  1700.     }
  1701.     RETURN;
  1702. }
  1703.  
  1704. PP(pp_lc)
  1705. {
  1706.     dSP;
  1707.     SV *sv = TOPs;
  1708.     register char *s;
  1709.     register char *send;
  1710.     STRLEN len;
  1711.  
  1712.     if (!SvPADTMP(sv)) {
  1713.     dTARGET;
  1714.     sv_setsv(TARG, sv);
  1715.     sv = TARG;
  1716.     SETs(sv);
  1717.     }
  1718.     s = SvPV_force(sv, len);
  1719.     send = s + len;
  1720.     while (s < send) {
  1721.     if (isUPPER(*s))
  1722.         *s = toLOWER(*s);
  1723.     s++;
  1724.     }
  1725.     RETURN;
  1726. }
  1727.  
  1728. PP(pp_quotemeta)
  1729. {
  1730.     dSP; dTARGET;
  1731.     SV *sv = TOPs;
  1732.     STRLEN len;
  1733.     register char *s = SvPV(sv,len);
  1734.     register char *d;
  1735.  
  1736.     if (len) {
  1737.     (void)SvUPGRADE(TARG, SVt_PV);
  1738.     SvGROW(TARG, (len * 2) + 1);
  1739.     d = SvPVX(TARG);
  1740.     while (len--) {
  1741.         if (!isALNUM(*s))
  1742.         *d++ = '\\';
  1743.         *d++ = *s++;
  1744.     }
  1745.     *d = '\0';
  1746.     SvCUR_set(TARG, d - SvPVX(TARG));
  1747.     (void)SvPOK_only(TARG);
  1748.     }
  1749.     else
  1750.     sv_setpvn(TARG, s, len);
  1751.     SETs(TARG);
  1752.     RETURN;
  1753. }
  1754.  
  1755. /* Arrays. */
  1756.  
  1757. PP(pp_aslice)
  1758. {
  1759.     dSP; dMARK; dORIGMARK;
  1760.     register SV** svp;
  1761.     register AV* av = (AV*)POPs;
  1762.     register I32 lval = op->op_flags & OPf_MOD;
  1763.     I32 arybase = curcop->cop_arybase;
  1764.     I32 elem;
  1765.  
  1766.     if (SvTYPE(av) == SVt_PVAV) {
  1767.     if (lval && op->op_private & OPpLVAL_INTRO) {
  1768.         I32 max = -1;
  1769.         for (svp = mark + 1; svp <= sp; svp++) {
  1770.         elem = SvIVx(*svp);
  1771.         if (elem > max)
  1772.             max = elem;
  1773.         }
  1774.         if (max > AvMAX(av))
  1775.         av_extend(av, max);
  1776.     }
  1777.     while (++MARK <= SP) {
  1778.         elem = SvIVx(*MARK);
  1779.  
  1780.         if (elem > 0)
  1781.         elem -= arybase;
  1782.         svp = av_fetch(av, elem, lval);
  1783.         if (lval) {
  1784.         if (!svp || *svp == &sv_undef)
  1785.             DIE(no_aelem, elem);
  1786.         if (op->op_private & OPpLVAL_INTRO)
  1787.             save_svref(svp);
  1788.         }
  1789.         *MARK = svp ? *svp : &sv_undef;
  1790.     }
  1791.     }
  1792.     if (GIMME != G_ARRAY) {
  1793.     MARK = ORIGMARK;
  1794.     *++MARK = *SP;
  1795.     SP = MARK;
  1796.     }
  1797.     RETURN;
  1798. }
  1799.  
  1800. /* Associative arrays. */
  1801.  
  1802. PP(pp_each)
  1803. {
  1804.     dSP; dTARGET;
  1805.     HV *hash = (HV*)POPs;
  1806.     HE *entry;
  1807.     I32 i;
  1808.     char *tmps;
  1809.     
  1810.     PUTBACK;
  1811.     entry = hv_iternext(hash);                        /* might clobber stack_sp */
  1812.     SPAGAIN;
  1813.  
  1814.     EXTEND(SP, 2);
  1815.     if (entry) {
  1816.     tmps = hv_iterkey(entry, &i);                  /* won't clobber stack_sp */
  1817.     if (!i)
  1818.         tmps = "";
  1819.     PUSHs(sv_2mortal(newSVpv(tmps, i)));
  1820.     if (GIMME == G_ARRAY) {
  1821.         PUTBACK;
  1822.         sv_setsv(TARG, hv_iterval(hash, entry));  /* might clobber stack_sp */
  1823.         SPAGAIN;
  1824.         PUSHs(TARG);
  1825.     }
  1826.     }
  1827.     else if (GIMME == G_SCALAR)
  1828.     RETPUSHUNDEF;
  1829.  
  1830.     RETURN;
  1831. }
  1832.  
  1833. PP(pp_values)
  1834. {
  1835.     return do_kv(ARGS);
  1836. }
  1837.  
  1838. PP(pp_keys)
  1839. {
  1840.     return do_kv(ARGS);
  1841. }
  1842.  
  1843. PP(pp_delete)
  1844. {
  1845.     dSP;
  1846.     SV *sv;
  1847.     SV *tmpsv = POPs;
  1848.     HV *hv = (HV*)POPs;
  1849.     char *tmps;
  1850.     STRLEN len;
  1851.     if (SvTYPE(hv) != SVt_PVHV) {
  1852.     DIE("Not a HASH reference");
  1853.     }
  1854.     tmps = SvPV(tmpsv, len);
  1855.     sv = hv_delete(hv, tmps, len,
  1856.     op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0);
  1857.     if (!sv)
  1858.     RETPUSHUNDEF;
  1859.     PUSHs(sv);
  1860.     RETURN;
  1861. }
  1862.  
  1863. PP(pp_exists)
  1864. {
  1865.     dSP;
  1866.     SV *tmpsv = POPs;
  1867.     HV *hv = (HV*)POPs;
  1868.     char *tmps;
  1869.     STRLEN len;
  1870.     if (SvTYPE(hv) != SVt_PVHV) {
  1871.     DIE("Not a HASH reference");
  1872.     }
  1873.     tmps = SvPV(tmpsv, len);
  1874.     if (hv_exists(hv, tmps, len))
  1875.     RETPUSHYES;
  1876.     RETPUSHNO;
  1877. }
  1878.  
  1879. PP(pp_hslice)
  1880. {
  1881.     dSP; dMARK; dORIGMARK;
  1882.     register SV **svp;
  1883.     register HV *hv = (HV*)POPs;
  1884.     register I32 lval = op->op_flags & OPf_MOD;
  1885.  
  1886.     if (SvTYPE(hv) == SVt_PVHV) {
  1887.     while (++MARK <= SP) {
  1888.         STRLEN keylen;
  1889.         char *key = SvPV(*MARK, keylen);
  1890.  
  1891.         svp = hv_fetch(hv, key, keylen, lval);
  1892.         if (lval) {
  1893.         if (!svp || *svp == &sv_undef)
  1894.             DIE(no_helem, key);
  1895.         if (op->op_private & OPpLVAL_INTRO)
  1896.             save_svref(svp);
  1897.         }
  1898.         *MARK = svp ? *svp : &sv_undef;
  1899.     }
  1900.     }
  1901.     if (GIMME != G_ARRAY) {
  1902.     MARK = ORIGMARK;
  1903.     *++MARK = *SP;
  1904.     SP = MARK;
  1905.     }
  1906.     RETURN;
  1907. }
  1908.  
  1909. /* List operators. */
  1910.  
  1911. PP(pp_list)
  1912. {
  1913.     dSP; dMARK;
  1914.     if (GIMME != G_ARRAY) {
  1915.     if (++MARK <= SP)
  1916.         *MARK = *SP;        /* unwanted list, return last item */
  1917.     else
  1918.         *MARK = &sv_undef;
  1919.     SP = MARK;
  1920.     }
  1921.     RETURN;
  1922. }
  1923.  
  1924. PP(pp_lslice)
  1925. {
  1926.     dSP;
  1927.     SV **lastrelem = stack_sp;
  1928.     SV **lastlelem = stack_base + POPMARK;
  1929.     SV **firstlelem = stack_base + POPMARK + 1;
  1930.     register SV **firstrelem = lastlelem + 1;
  1931.     I32 arybase = curcop->cop_arybase;
  1932.     I32 lval = op->op_flags & OPf_MOD;
  1933.     I32 is_something_there = lval;
  1934.  
  1935.     register I32 max = lastrelem - lastlelem;
  1936.     register SV **lelem;
  1937.     register I32 ix;
  1938.  
  1939.     if (GIMME != G_ARRAY) {
  1940.     ix = SvIVx(*lastlelem);
  1941.     if (ix < 0)
  1942.         ix += max;
  1943.     else
  1944.         ix -= arybase;
  1945.     if (ix < 0 || ix >= max)
  1946.         *firstlelem = &sv_undef;
  1947.     else
  1948.         *firstlelem = firstrelem[ix];
  1949.     SP = firstlelem;
  1950.     RETURN;
  1951.     }
  1952.  
  1953.     if (max == 0) {
  1954.     SP = firstlelem - 1;
  1955.     RETURN;
  1956.     }
  1957.  
  1958.     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
  1959.     ix = SvIVx(*lelem);
  1960.     if (ix < 0) {
  1961.         ix += max;
  1962.         if (ix < 0)
  1963.         *lelem = &sv_undef;
  1964.         else if (!(*lelem = firstrelem[ix]))
  1965.         *lelem = &sv_undef;
  1966.     }
  1967.     else {
  1968.         ix -= arybase;
  1969.         if (ix >= max || !(*lelem = firstrelem[ix]))
  1970.         *lelem = &sv_undef;
  1971.     }
  1972.     if (!is_something_there && (SvOKp(*lelem) || SvGMAGICAL(*lelem)))
  1973.         is_something_there = TRUE;
  1974.     }
  1975.     if (is_something_there)
  1976.     SP = lastlelem;
  1977.     else
  1978.     SP = firstlelem - 1;
  1979.     RETURN;
  1980. }
  1981.  
  1982. PP(pp_anonlist)
  1983. {
  1984.     dSP; dMARK;
  1985.     I32 items = SP - MARK;
  1986.     SP = MARK;
  1987.     XPUSHs((SV*)sv_2mortal((SV*)av_make(items, MARK+1)));
  1988.     RETURN;
  1989. }
  1990.  
  1991. PP(pp_anonhash)
  1992. {
  1993.     dSP; dMARK; dORIGMARK;
  1994.     STRLEN len;
  1995.     HV* hv = (HV*)sv_2mortal((SV*)newHV());
  1996.  
  1997.     while (MARK < SP) {
  1998.     SV* key = *++MARK;
  1999.     char *tmps;
  2000.     SV *val = NEWSV(46, 0);
  2001.     if (MARK < SP)
  2002.         sv_setsv(val, *++MARK);
  2003.     else
  2004.         warn("Odd number of elements in hash list");
  2005.     tmps = SvPV(key,len);
  2006.     (void)hv_store(hv,tmps,len,val,0);
  2007.     }
  2008.     SP = ORIGMARK;
  2009.     XPUSHs((SV*)hv);
  2010.     RETURN;
  2011. }
  2012.  
  2013. PP(pp_splice)
  2014. {
  2015.     dSP; dMARK; dORIGMARK;
  2016.     register AV *ary = (AV*)*++MARK;
  2017.     register SV **src;
  2018.     register SV **dst;
  2019.     register I32 i;
  2020.     register I32 offset;
  2021.     register I32 length;
  2022.     I32 newlen;
  2023.     I32 after;
  2024.     I32 diff;
  2025.     SV **tmparyval = 0;
  2026.  
  2027.     SP++;
  2028.  
  2029.     if (++MARK < SP) {
  2030.     offset = SvIVx(*MARK);
  2031.     if (offset < 0)
  2032.         offset += AvFILL(ary) + 1;
  2033.     else
  2034.         offset -= curcop->cop_arybase;
  2035.     if (++MARK < SP) {
  2036.         length = SvIVx(*MARK++);
  2037.         if (length < 0)
  2038.         length = 0;
  2039.     }
  2040.     else
  2041.         length = AvMAX(ary) + 1;        /* close enough to infinity */
  2042.     }
  2043.     else {
  2044.     offset = 0;
  2045.     length = AvMAX(ary) + 1;
  2046.     }
  2047.     if (offset < 0) {
  2048.     length += offset;
  2049.     offset = 0;
  2050.     if (length < 0)
  2051.         length = 0;
  2052.     }
  2053.     if (offset > AvFILL(ary) + 1)
  2054.     offset = AvFILL(ary) + 1;
  2055.     after = AvFILL(ary) + 1 - (offset + length);
  2056.     if (after < 0) {                /* not that much array */
  2057.     length += after;            /* offset+length now in array */
  2058.     after = 0;
  2059.     if (!AvALLOC(ary))
  2060.         av_extend(ary, 0);
  2061.     }
  2062.  
  2063.     /* At this point, MARK .. SP-1 is our new LIST */
  2064.  
  2065.     newlen = SP - MARK;
  2066.     diff = newlen - length;
  2067.  
  2068.     if (diff < 0) {                /* shrinking the area */
  2069.     if (newlen) {
  2070.         New(451, tmparyval, newlen, SV*);    /* so remember insertion */
  2071.         Copy(MARK, tmparyval, newlen, SV*);
  2072.     }
  2073.  
  2074.     MARK = ORIGMARK + 1;
  2075.     if (GIMME == G_ARRAY) {            /* copy return vals to stack */
  2076.         MEXTEND(MARK, length);
  2077.         Copy(AvARRAY(ary)+offset, MARK, length, SV*);
  2078.         if (AvREAL(ary)) {
  2079.         for (i = length, dst = MARK; i; i--)
  2080.             sv_2mortal(*dst++);    /* free them eventualy */
  2081.         }
  2082.         MARK += length - 1;
  2083.     }
  2084.     else {
  2085.         *MARK = AvARRAY(ary)[offset+length-1];
  2086.         if (AvREAL(ary)) {
  2087.         sv_2mortal(*MARK);
  2088.         for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
  2089.             SvREFCNT_dec(*dst++);    /* free them now */
  2090.         }
  2091.     }
  2092.     AvFILL(ary) += diff;
  2093.  
  2094.     /* pull up or down? */
  2095.  
  2096.     if (offset < after) {            /* easier to pull up */
  2097.         if (offset) {            /* esp. if nothing to pull */
  2098.         src = &AvARRAY(ary)[offset-1];
  2099.         dst = src - diff;        /* diff is negative */
  2100.         for (i = offset; i > 0; i--)    /* can't trust Copy */
  2101.             *dst-- = *src--;
  2102.         }
  2103.         dst = AvARRAY(ary);
  2104.         SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
  2105.         AvMAX(ary) += diff;
  2106.     }
  2107.     else {
  2108.         if (after) {            /* anything to pull down? */
  2109.         src = AvARRAY(ary) + offset + length;
  2110.         dst = src + diff;        /* diff is negative */
  2111.         Move(src, dst, after, SV*);
  2112.         }
  2113.         dst = &AvARRAY(ary)[AvFILL(ary)+1];
  2114.                         /* avoid later double free */
  2115.     }
  2116.     i = -diff;
  2117.     while (i)
  2118.         dst[--i] = &sv_undef;
  2119.     
  2120.     if (newlen) {
  2121.         for (src = tmparyval, dst = AvARRAY(ary) + offset;
  2122.           newlen; newlen--) {
  2123.         *dst = NEWSV(46, 0);
  2124.         sv_setsv(*dst++, *src++);
  2125.         }
  2126.         Safefree(tmparyval);
  2127.     }
  2128.     }
  2129.     else {                    /* no, expanding (or same) */
  2130.     if (length) {
  2131.         New(452, tmparyval, length, SV*);    /* so remember deletion */
  2132.         Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
  2133.     }
  2134.  
  2135.     if (diff > 0) {                /* expanding */
  2136.  
  2137.         /* push up or down? */
  2138.  
  2139.         if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
  2140.         if (offset) {
  2141.             src = AvARRAY(ary);
  2142.             dst = src - diff;
  2143.             Move(src, dst, offset, SV*);
  2144.         }
  2145.         SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
  2146.         AvMAX(ary) += diff;
  2147.         AvFILL(ary) += diff;
  2148.         }
  2149.         else {
  2150.         if (AvFILL(ary) + diff >= AvMAX(ary))    /* oh, well */
  2151.             av_extend(ary, AvFILL(ary) + diff);
  2152.         AvFILL(ary) += diff;
  2153.  
  2154.         if (after) {
  2155.             dst = AvARRAY(ary) + AvFILL(ary);
  2156.             src = dst - diff;
  2157.             for (i = after; i; i--) {
  2158.             *dst-- = *src--;
  2159.             }
  2160.         }
  2161.         }
  2162.     }
  2163.  
  2164.     for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
  2165.         *dst = NEWSV(46, 0);
  2166.         sv_setsv(*dst++, *src++);
  2167.     }
  2168.     MARK = ORIGMARK + 1;
  2169.     if (GIMME == G_ARRAY) {            /* copy return vals to stack */
  2170.         if (length) {
  2171.         Copy(tmparyval, MARK, length, SV*);
  2172.         if (AvREAL(ary)) {
  2173.             for (i = length, dst = MARK; i; i--)
  2174.             sv_2mortal(*dst++);    /* free them eventualy */
  2175.         }
  2176.         Safefree(tmparyval);
  2177.         }
  2178.         MARK += length - 1;
  2179.     }
  2180.     else if (length--) {
  2181.         *MARK = tmparyval[length];
  2182.         if (AvREAL(ary)) {
  2183.         sv_2mortal(*MARK);
  2184.         while (length-- > 0)
  2185.             SvREFCNT_dec(tmparyval[length]);
  2186.         }
  2187.         Safefree(tmparyval);
  2188.     }
  2189.     else
  2190.         *MARK = &sv_undef;
  2191.     }
  2192.     SP = MARK;
  2193.     RETURN;
  2194. }
  2195.  
  2196. PP(pp_push)
  2197. {
  2198.     dSP; dMARK; dORIGMARK; dTARGET;
  2199.     register AV *ary = (AV*)*++MARK;
  2200.     register SV *sv = &sv_undef;
  2201.  
  2202.     for (++MARK; MARK <= SP; MARK++) {
  2203.     sv = NEWSV(51, 0);
  2204.     if (*MARK)
  2205.         sv_setsv(sv, *MARK);
  2206.     av_push(ary, sv);
  2207.     }
  2208.     SP = ORIGMARK;
  2209.     PUSHi( AvFILL(ary) + 1 );
  2210.     RETURN;
  2211. }
  2212.  
  2213. PP(pp_pop)
  2214. {
  2215.     dSP;
  2216.     AV *av = (AV*)POPs;
  2217.     SV *sv = av_pop(av);
  2218.     if (sv != &sv_undef && AvREAL(av))
  2219.     (void)sv_2mortal(sv);
  2220.     PUSHs(sv);
  2221.     RETURN;
  2222. }
  2223.  
  2224. PP(pp_shift)
  2225. {
  2226.     dSP;
  2227.     AV *av = (AV*)POPs;
  2228.     SV *sv = av_shift(av);
  2229.     EXTEND(SP, 1);
  2230.     if (!sv)
  2231.     RETPUSHUNDEF;
  2232.     if (sv != &sv_undef && AvREAL(av))
  2233.     (void)sv_2mortal(sv);
  2234.     PUSHs(sv);
  2235.     RETURN;
  2236. }
  2237.  
  2238. PP(pp_unshift)
  2239. {
  2240.     dSP; dMARK; dORIGMARK; dTARGET;
  2241.     register AV *ary = (AV*)*++MARK;
  2242.     register SV *sv;
  2243.     register I32 i = 0;
  2244.  
  2245.     av_unshift(ary, SP - MARK);
  2246.     while (MARK < SP) {
  2247.     sv = NEWSV(27, 0);
  2248.     sv_setsv(sv, *++MARK);
  2249.     (void)av_store(ary, i++, sv);
  2250.     }
  2251.  
  2252.     SP = ORIGMARK;
  2253.     PUSHi( AvFILL(ary) + 1 );
  2254.     RETURN;
  2255. }
  2256.  
  2257. PP(pp_reverse)
  2258. {
  2259.     dSP; dMARK;
  2260.     register SV *tmp;
  2261.     SV **oldsp = SP;
  2262.  
  2263.     if (GIMME == G_ARRAY) {
  2264.     MARK++;
  2265.     while (MARK < SP) {
  2266.         tmp = *MARK;
  2267.         *MARK++ = *SP;
  2268.         *SP-- = tmp;
  2269.     }
  2270.     SP = oldsp;
  2271.     }
  2272.     else {
  2273.     register char *up;
  2274.     register char *down;
  2275.     register I32 tmp;
  2276.     dTARGET;
  2277.     STRLEN len;
  2278.  
  2279.     if (SP - MARK > 1)
  2280.         do_join(TARG, &sv_no, MARK, SP);
  2281.     else
  2282.         sv_setsv(TARG, *SP);
  2283.     up = SvPV_force(TARG, len);
  2284.     if (len > 1) {
  2285.         down = SvPVX(TARG) + len - 1;
  2286.         while (down > up) {
  2287.         tmp = *up;
  2288.         *up++ = *down;
  2289.         *down-- = tmp;
  2290.         }
  2291.         (void)SvPOK_only(TARG);
  2292.     }
  2293.     SP = MARK + 1;
  2294.     SETTARG;
  2295.     }
  2296.     RETURN;
  2297. }
  2298.  
  2299. /* Explosives and implosives. */
  2300.  
  2301. PP(pp_unpack)
  2302. {
  2303.     dSP;
  2304.     dPOPPOPssrl;
  2305.     SV *sv;
  2306.     STRLEN llen;
  2307.     STRLEN rlen;
  2308.     register char *pat = SvPV(left, llen);
  2309.     register char *s = SvPV(right, rlen);
  2310.     char *strend = s + rlen;
  2311.     char *strbeg = s;
  2312.     register char *patend = pat + llen;
  2313.     I32 datumtype;
  2314.     register I32 len;
  2315.     register I32 bits;
  2316.  
  2317.     /* These must not be in registers: */
  2318.     I16 ashort;
  2319.     int aint;
  2320.     I32 along;
  2321. #ifdef HAS_QUAD
  2322.     Quad_t aquad;
  2323. #endif
  2324.     U16 aushort;
  2325.     unsigned int auint;
  2326.     U32 aulong;
  2327. #ifdef HAS_QUAD
  2328.     unsigned Quad_t auquad;
  2329. #endif
  2330.     char *aptr;
  2331.     float afloat;
  2332.     double adouble;
  2333.     I32 checksum = 0;
  2334.     register U32 culong;
  2335.     double cdouble;
  2336. #ifdef macintosh
  2337.     static char bitcount[256] =
  2338.               { 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4,
  2339.                 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  2340.                 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  2341.                 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  2342.                 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  2343.                 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  2344.                 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  2345.                 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  2346.                 1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  2347.                 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  2348.                 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  2349.                 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  2350.                 2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  2351.                 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  2352.                 3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  2353.                 4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8 };
  2354. #else
  2355.     static char* bitcount = 0;
  2356. #endif
  2357.  
  2358.     if (GIMME != G_ARRAY) {        /* arrange to do first one only */
  2359.     /*SUPPRESS 530*/
  2360.     for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
  2361.     if (strchr("aAbBhHP", *patend) || *pat == '%') {
  2362.         patend++;
  2363.         while (isDIGIT(*patend) || *patend == '*')
  2364.         patend++;
  2365.     }
  2366.     else
  2367.         patend++;
  2368.     }
  2369.     while (pat < patend) {
  2370.       reparse:
  2371.     datumtype = *pat++;
  2372.     if (pat >= patend)
  2373.         len = 1;
  2374.     else if (*pat == '*') {
  2375.         len = strend - strbeg;    /* long enough */
  2376.         pat++;
  2377.     }
  2378.     else if (isDIGIT(*pat)) {
  2379.         len = *pat++ - '0';
  2380.         while (isDIGIT(*pat))
  2381.         len = (len * 10) + (*pat++ - '0');
  2382.     }
  2383.     else
  2384.         len = (datumtype != '@');
  2385.     switch(datumtype) {
  2386.     default:
  2387.         break;
  2388.     case '%':
  2389.         if (len == 1 && pat[-1] != '1')
  2390.         len = 16;
  2391.         checksum = len;
  2392.         culong = 0;
  2393.         cdouble = 0;
  2394.         if (pat < patend)
  2395.         goto reparse;
  2396.         break;
  2397.     case '@':
  2398.         if (len > strend - strbeg)
  2399.         DIE("@ outside of string");
  2400.         s = strbeg + len;
  2401.         break;
  2402.     case 'X':
  2403.         if (len > s - strbeg)
  2404.         DIE("X outside of string");
  2405.         s -= len;
  2406.         break;
  2407.     case 'x':
  2408.         if (len > strend - s)
  2409.         DIE("x outside of string");
  2410.         s += len;
  2411.         break;
  2412.     case 'A':
  2413.     case 'a':
  2414.         if (len > strend - s)
  2415.         len = strend - s;
  2416.         if (checksum)
  2417.         goto uchar_checksum;
  2418.         sv = NEWSV(35, len);
  2419.         sv_setpvn(sv, s, len);
  2420.         s += len;
  2421.         if (datumtype == 'A') {
  2422.         aptr = s;    /* borrow register */
  2423.         s = SvPVX(sv) + len - 1;
  2424.         while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
  2425.             s--;
  2426.         *++s = '\0';
  2427.         SvCUR_set(sv, s - SvPVX(sv));
  2428.         s = aptr;    /* unborrow register */
  2429.         }
  2430.         XPUSHs(sv_2mortal(sv));
  2431.         break;
  2432.     case 'B':
  2433.     case 'b':
  2434.         if (pat[-1] == '*' || len > (strend - s) * 8)
  2435.         len = (strend - s) * 8;
  2436.         if (checksum) {
  2437. #ifndef macintosh
  2438.         if (!bitcount) {
  2439.             Newz(601, bitcount, 256, char);
  2440.             for (bits = 1; bits < 256; bits++) {
  2441.             if (bits & 1)    bitcount[bits]++;
  2442.             if (bits & 2)    bitcount[bits]++;
  2443.             if (bits & 4)    bitcount[bits]++;
  2444.             if (bits & 8)    bitcount[bits]++;
  2445.             if (bits & 16)    bitcount[bits]++;
  2446.             if (bits & 32)    bitcount[bits]++;
  2447.             if (bits & 64)    bitcount[bits]++;
  2448.             if (bits & 128)    bitcount[bits]++;
  2449.             }
  2450.         }
  2451. #endif
  2452.         while (len >= 8) {
  2453.             culong += bitcount[*(unsigned char*)s++];
  2454.             len -= 8;
  2455.         }
  2456.         if (len) {
  2457.             bits = *s;
  2458.             if (datumtype == 'b') {
  2459.             while (len-- > 0) {
  2460.                 if (bits & 1) culong++;
  2461.                 bits >>= 1;
  2462.             }
  2463.             }
  2464.             else {
  2465.             while (len-- > 0) {
  2466.                 if (bits & 128) culong++;
  2467.                 bits <<= 1;
  2468.             }
  2469.             }
  2470.         }
  2471.         break;
  2472.         }
  2473.         sv = NEWSV(35, len + 1);
  2474.         SvCUR_set(sv, len);
  2475.         SvPOK_on(sv);
  2476.         aptr = pat;            /* borrow register */
  2477.         pat = SvPVX(sv);
  2478.         if (datumtype == 'b') {
  2479.         aint = len;
  2480.         for (len = 0; len < aint; len++) {
  2481.             if (len & 7)        /*SUPPRESS 595*/
  2482.             bits >>= 1;
  2483.             else
  2484.             bits = *s++;
  2485.             *pat++ = '0' + (bits & 1);
  2486.         }
  2487.         }
  2488.         else {
  2489.         aint = len;
  2490.         for (len = 0; len < aint; len++) {
  2491.             if (len & 7)
  2492.             bits <<= 1;
  2493.             else
  2494.             bits = *s++;
  2495.             *pat++ = '0' + ((bits & 128) != 0);
  2496.         }
  2497.         }
  2498.         *pat = '\0';
  2499.         pat = aptr;            /* unborrow register */
  2500.         XPUSHs(sv_2mortal(sv));
  2501.         break;
  2502.     case 'H':
  2503.     case 'h':
  2504.         if (pat[-1] == '*' || len > (strend - s) * 2)
  2505.         len = (strend - s) * 2;
  2506.         sv = NEWSV(35, len + 1);
  2507.         SvCUR_set(sv, len);
  2508.         SvPOK_on(sv);
  2509.         aptr = pat;            /* borrow register */
  2510.         pat = SvPVX(sv);
  2511.         if (datumtype == 'h') {
  2512.         aint = len;
  2513.         for (len = 0; len < aint; len++) {
  2514.             if (len & 1)
  2515.             bits >>= 4;
  2516.             else
  2517.             bits = *s++;
  2518.             *pat++ = hexdigit[bits & 15];
  2519.         }
  2520.         }
  2521.         else {
  2522.         aint = len;
  2523.         for (len = 0; len < aint; len++) {
  2524.             if (len & 1)
  2525.             bits <<= 4;
  2526.             else
  2527.             bits = *s++;
  2528.             *pat++ = hexdigit[(bits >> 4) & 15];
  2529.         }
  2530.         }
  2531.         *pat = '\0';
  2532.         pat = aptr;            /* unborrow register */
  2533.         XPUSHs(sv_2mortal(sv));
  2534.         break;
  2535.     case 'c':
  2536.         if (len > strend - s)
  2537.         len = strend - s;
  2538.         if (checksum) {
  2539.         while (len-- > 0) {
  2540.             aint = *s++;
  2541.             if (aint >= 128)    /* fake up signed chars */
  2542.             aint -= 256;
  2543.             culong += aint;
  2544.         }
  2545.         }
  2546.         else {
  2547.         EXTEND(SP, len);
  2548.         while (len-- > 0) {
  2549.             aint = *s++;
  2550.             if (aint >= 128)    /* fake up signed chars */
  2551.             aint -= 256;
  2552.             sv = NEWSV(36, 0);
  2553.             sv_setiv(sv, (I32)aint);
  2554.             PUSHs(sv_2mortal(sv));
  2555.         }
  2556.         }
  2557.         break;
  2558.     case 'C':
  2559.         if (len > strend - s)
  2560.         len = strend - s;
  2561.         if (checksum) {
  2562.           uchar_checksum:
  2563.         while (len-- > 0) {
  2564.             auint = *s++ & 255;
  2565.             culong += auint;
  2566.         }
  2567.         }
  2568.         else {
  2569.         EXTEND(SP, len);
  2570.         while (len-- > 0) {
  2571.             auint = *s++ & 255;
  2572.             sv = NEWSV(37, 0);
  2573.             sv_setiv(sv, (I32)auint);
  2574.             PUSHs(sv_2mortal(sv));
  2575.         }
  2576.         }
  2577.         break;
  2578.     case 's':
  2579.         along = (strend - s) / sizeof(I16);
  2580.         if (len > along)
  2581.         len = along;
  2582.         if (checksum) {
  2583.         while (len-- > 0) {
  2584.             Copy(s, &ashort, 1, I16);
  2585.             s += sizeof(I16);
  2586.             culong += ashort;
  2587.         }
  2588.         }
  2589.         else {
  2590.         EXTEND(SP, len);
  2591.         while (len-- > 0) {
  2592.             Copy(s, &ashort, 1, I16);
  2593.             s += sizeof(I16);
  2594.             sv = NEWSV(38, 0);
  2595.             sv_setiv(sv, (I32)ashort);
  2596.             PUSHs(sv_2mortal(sv));
  2597.         }
  2598.         }
  2599.         break;
  2600.     case 'v':
  2601.     case 'n':
  2602.     case 'S':
  2603.         along = (strend - s) / sizeof(U16);
  2604.         if (len > along)
  2605.         len = along;
  2606.         if (checksum) {
  2607.         while (len-- > 0) {
  2608.             Copy(s, &aushort, 1, U16);
  2609.             s += sizeof(U16);
  2610. #ifdef HAS_NTOHS
  2611.             if (datumtype == 'n')
  2612.             aushort = ntohs(aushort);
  2613. #endif
  2614. #ifdef HAS_VTOHS
  2615.             if (datumtype == 'v')
  2616.             aushort = vtohs(aushort);
  2617. #endif
  2618.             culong += aushort;
  2619.         }
  2620.         }
  2621.         else {
  2622.         EXTEND(SP, len);
  2623.         while (len-- > 0) {
  2624.             Copy(s, &aushort, 1, U16);
  2625.             s += sizeof(U16);
  2626.             sv = NEWSV(39, 0);
  2627. #ifdef HAS_NTOHS
  2628.             if (datumtype == 'n')
  2629.             aushort = ntohs(aushort);
  2630. #endif
  2631. #ifdef HAS_VTOHS
  2632.             if (datumtype == 'v')
  2633.             aushort = vtohs(aushort);
  2634. #endif
  2635.             sv_setiv(sv, (I32)aushort);
  2636.             PUSHs(sv_2mortal(sv));
  2637.         }
  2638.         }
  2639.         break;
  2640.     case 'i':
  2641.         along = (strend - s) / sizeof(int);
  2642.         if (len > along)
  2643.         len = along;
  2644.         if (checksum) {
  2645.         while (len-- > 0) {
  2646.             Copy(s, &aint, 1, int);
  2647.             s += sizeof(int);
  2648.             if (checksum > 32)
  2649.             cdouble += (double)aint;
  2650.             else
  2651.             culong += aint;
  2652.         }
  2653.         }
  2654.         else {
  2655.         EXTEND(SP, len);
  2656.         while (len-- > 0) {
  2657.             Copy(s, &aint, 1, int);
  2658.             s += sizeof(int);
  2659.             sv = NEWSV(40, 0);
  2660.             sv_setiv(sv, (I32)aint);
  2661.             PUSHs(sv_2mortal(sv));
  2662.         }
  2663.         }
  2664.         break;
  2665.     case 'I':
  2666.         along = (strend - s) / sizeof(unsigned int);
  2667.         if (len > along)
  2668.         len = along;
  2669.         if (checksum) {
  2670.         while (len-- > 0) {
  2671.             Copy(s, &auint, 1, unsigned int);
  2672.             s += sizeof(unsigned int);
  2673.             if (checksum > 32)
  2674.             cdouble += (double)auint;
  2675.             else
  2676.             culong += auint;
  2677.         }
  2678.         }
  2679.         else {
  2680.         EXTEND(SP, len);
  2681.         while (len-- > 0) {
  2682.             Copy(s, &auint, 1, unsigned int);
  2683.             s += sizeof(unsigned int);
  2684.             sv = NEWSV(41, 0);
  2685.             sv_setiv(sv, (I32)auint);
  2686.             PUSHs(sv_2mortal(sv));
  2687.         }
  2688.         }
  2689.         break;
  2690.     case 'l':
  2691.         along = (strend - s) / sizeof(I32);
  2692.         if (len > along)
  2693.         len = along;
  2694.         if (checksum) {
  2695.         while (len-- > 0) {
  2696.             Copy(s, &along, 1, I32);
  2697.             s += sizeof(I32);
  2698.             if (checksum > 32)
  2699.             cdouble += (double)along;
  2700.             else
  2701.             culong += along;
  2702.         }
  2703.         }
  2704.         else {
  2705.         EXTEND(SP, len);
  2706.         while (len-- > 0) {
  2707.             Copy(s, &along, 1, I32);
  2708.             s += sizeof(I32);
  2709.             sv = NEWSV(42, 0);
  2710.             sv_setiv(sv, (I32)along);
  2711.             PUSHs(sv_2mortal(sv));
  2712.         }
  2713.         }
  2714.         break;
  2715.     case 'V':
  2716.     case 'N':
  2717.     case 'L':
  2718.         along = (strend - s) / sizeof(U32);
  2719.         if (len > along)
  2720.         len = along;
  2721.         if (checksum) {
  2722.         while (len-- > 0) {
  2723.             Copy(s, &aulong, 1, U32);
  2724.             s += sizeof(U32);
  2725. #ifdef HAS_NTOHL
  2726.             if (datumtype == 'N')
  2727.             aulong = ntohl(aulong);
  2728. #endif
  2729. #ifdef HAS_VTOHL
  2730.             if (datumtype == 'V')
  2731.             aulong = vtohl(aulong);
  2732. #endif
  2733.             if (checksum > 32)
  2734.             cdouble += (double)aulong;
  2735.             else
  2736.             culong += aulong;
  2737.         }
  2738.         }
  2739.         else {
  2740.         EXTEND(SP, len);
  2741.         while (len-- > 0) {
  2742.             Copy(s, &aulong, 1, U32);
  2743.             s += sizeof(U32);
  2744.             sv = NEWSV(43, 0);
  2745. #ifdef HAS_NTOHL
  2746.             if (datumtype == 'N')
  2747.             aulong = ntohl(aulong);
  2748. #endif
  2749. #ifdef HAS_VTOHL
  2750.             if (datumtype == 'V')
  2751.             aulong = vtohl(aulong);
  2752. #endif
  2753.             sv_setnv(sv, (double)aulong);
  2754.             PUSHs(sv_2mortal(sv));
  2755.         }
  2756.         }
  2757.         break;
  2758.     case 'p':
  2759.         along = (strend - s) / sizeof(char*);
  2760.         if (len > along)
  2761.         len = along;
  2762.         EXTEND(SP, len);
  2763.         while (len-- > 0) {
  2764.         if (sizeof(char*) > strend - s)
  2765.             break;
  2766.         else {
  2767.             Copy(s, &aptr, 1, char*);
  2768.             s += sizeof(char*);
  2769.         }
  2770.         sv = NEWSV(44, 0);
  2771.         if (aptr)
  2772.             sv_setpv(sv, aptr);
  2773.         PUSHs(sv_2mortal(sv));
  2774.         }
  2775.         break;
  2776.     case 'P':
  2777.         EXTEND(SP, 1);
  2778.         if (sizeof(char*) > strend - s)
  2779.         break;
  2780.         else {
  2781.         Copy(s, &aptr, 1, char*);
  2782.         s += sizeof(char*);
  2783.         }
  2784.         sv = NEWSV(44, 0);
  2785.         if (aptr)
  2786.         sv_setpvn(sv, aptr, len);
  2787.         PUSHs(sv_2mortal(sv));
  2788.         break;
  2789. #ifdef HAS_QUAD
  2790.     case 'q':
  2791.         EXTEND(SP, len);
  2792.         while (len-- > 0) {
  2793.         if (s + sizeof(Quad_t) > strend)
  2794.             aquad = 0;
  2795.         else {
  2796.             Copy(s, &aquad, 1, Quad_t);
  2797.             s += sizeof(Quad_t);
  2798.         }
  2799.         sv = NEWSV(42, 0);
  2800.         sv_setiv(sv, (IV)aquad);
  2801.         PUSHs(sv_2mortal(sv));
  2802.         }
  2803.         break;
  2804.     case 'Q':
  2805.         EXTEND(SP, len);
  2806.         while (len-- > 0) {
  2807.         if (s + sizeof(unsigned Quad_t) > strend)
  2808.             auquad = 0;
  2809.         else {
  2810.             Copy(s, &auquad, 1, unsigned Quad_t);
  2811.             s += sizeof(unsigned Quad_t);
  2812.         }
  2813.         sv = NEWSV(43, 0);
  2814.         sv_setiv(sv, (IV)auquad);
  2815.         PUSHs(sv_2mortal(sv));
  2816.         }
  2817.         break;
  2818. #endif
  2819.     /* float and double added gnb@melba.bby.oz.au 22/11/89 */
  2820.     case 'f':
  2821.     case 'F':
  2822.         along = (strend - s) / sizeof(float);
  2823.         if (len > along)
  2824.         len = along;
  2825.         if (checksum) {
  2826.         while (len-- > 0) {
  2827.             Copy(s, &afloat, 1, float);
  2828.             s += sizeof(float);
  2829.             cdouble += afloat;
  2830.         }
  2831.         }
  2832.         else {
  2833.         EXTEND(SP, len);
  2834.         while (len-- > 0) {
  2835.             Copy(s, &afloat, 1, float);
  2836.             s += sizeof(float);
  2837.             sv = NEWSV(47, 0);
  2838.             sv_setnv(sv, (double)afloat);
  2839.             PUSHs(sv_2mortal(sv));
  2840.         }
  2841.         }
  2842.         break;
  2843.     case 'd':
  2844.     case 'D':
  2845.         along = (strend - s) / sizeof(double);
  2846.         if (len > along)
  2847.         len = along;
  2848.         if (checksum) {
  2849.         while (len-- > 0) {
  2850.             Copy(s, &adouble, 1, double);
  2851.             s += sizeof(double);
  2852.             cdouble += adouble;
  2853.         }
  2854.         }
  2855.         else {
  2856.         EXTEND(SP, len);
  2857.         while (len-- > 0) {
  2858.             Copy(s, &adouble, 1, double);
  2859.             s += sizeof(double);
  2860.             sv = NEWSV(48, 0);
  2861.             sv_setnv(sv, (double)adouble);
  2862.             PUSHs(sv_2mortal(sv));
  2863.         }
  2864.         }
  2865.         break;
  2866.     case 'u':
  2867.         along = (strend - s) * 3 / 4;
  2868.         sv = NEWSV(42, along);
  2869.         while (s < strend && *s > ' ' && *s < 'a') {
  2870.         I32 a, b, c, d;
  2871.         char hunk[4];
  2872.  
  2873.         hunk[3] = '\0';
  2874.         len = (*s++ - ' ') & 077;
  2875.         while (len > 0) {
  2876.             if (s < strend && *s >= ' ')
  2877.             a = (*s++ - ' ') & 077;
  2878.             else
  2879.             a = 0;
  2880.             if (s < strend && *s >= ' ')
  2881.             b = (*s++ - ' ') & 077;
  2882.             else
  2883.             b = 0;
  2884.             if (s < strend && *s >= ' ')
  2885.             c = (*s++ - ' ') & 077;
  2886.             else
  2887.             c = 0;
  2888.             if (s < strend && *s >= ' ')
  2889.             d = (*s++ - ' ') & 077;
  2890.             else
  2891.             d = 0;
  2892.             hunk[0] = a << 2 | b >> 4;
  2893.             hunk[1] = b << 4 | c >> 2;
  2894.             hunk[2] = c << 6 | d;
  2895.             sv_catpvn(sv, hunk, len > 3 ? 3 : len);
  2896.             len -= 3;
  2897.         }
  2898.         if (*s == '\n')
  2899.             s++;
  2900.         else if (s[1] == '\n')        /* possible checksum byte */
  2901.             s += 2;
  2902.         }
  2903.         XPUSHs(sv_2mortal(sv));
  2904.         break;
  2905.     }
  2906.     if (checksum) {
  2907.         sv = NEWSV(42, 0);
  2908.         if (strchr("fFdD", datumtype) ||
  2909.           (checksum > 32 && strchr("iIlLN", datumtype)) ) {
  2910. #if defined(macintosh) && !defined(powerc) && !defined(_powerc) && !defined(__MWERKS__)
  2911.         extended trouble;
  2912. #else
  2913.         double trouble;
  2914. #endif
  2915.  
  2916.         adouble = 1.0;
  2917.         while (checksum >= 16) {
  2918.             checksum -= 16;
  2919.             adouble *= 65536.0;
  2920.         }
  2921.         while (checksum >= 4) {
  2922.             checksum -= 4;
  2923.             adouble *= 16.0;
  2924.         }
  2925.         while (checksum--)
  2926.             adouble *= 2.0;
  2927.         along = (1 << checksum) - 1;
  2928.         while (cdouble < 0.0)
  2929.             cdouble += adouble;
  2930.         cdouble = modf(cdouble / adouble, &trouble) * adouble;
  2931.         sv_setnv(sv, cdouble);
  2932.         }
  2933.         else {
  2934.         if (checksum < 32) {
  2935.             along = (1 << checksum) - 1;
  2936.             culong &= (U32)along;
  2937.         }
  2938.         sv_setnv(sv, (double)culong);
  2939.         }
  2940.         XPUSHs(sv_2mortal(sv));
  2941.         checksum = 0;
  2942.     }
  2943.     }
  2944.     RETURN;
  2945. }
  2946.  
  2947. static void
  2948. doencodes(sv, s, len)
  2949. register SV *sv;
  2950. register char *s;
  2951. register I32 len;
  2952. {
  2953.     char hunk[5];
  2954.  
  2955.     *hunk = len + ' ';
  2956.     sv_catpvn(sv, hunk, 1);
  2957.     hunk[4] = '\0';
  2958.     while (len > 0) {
  2959.     hunk[0] = ' ' + (077 & (*s >> 2));
  2960.     hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
  2961.     hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
  2962.     hunk[3] = ' ' + (077 & (s[2] & 077));
  2963.     sv_catpvn(sv, hunk, 4);
  2964.     s += 3;
  2965.     len -= 3;
  2966.     }
  2967.     for (s = SvPVX(sv); *s; s++) {
  2968.     if (*s == ' ')
  2969.         *s = '`';
  2970.     }
  2971.     sv_catpvn(sv, "\n", 1);
  2972. }
  2973.  
  2974. PP(pp_pack)
  2975. {
  2976.     dSP; dMARK; dORIGMARK; dTARGET;
  2977.     register SV *cat = TARG;
  2978.     register I32 items;
  2979.     STRLEN fromlen;
  2980.     register char *pat = SvPVx(*++MARK, fromlen);
  2981.     register char *patend = pat + fromlen;
  2982.     register I32 len;
  2983.     I32 datumtype;
  2984.     SV *fromstr;
  2985.     /*SUPPRESS 442*/
  2986.     static char null10[] = {0,0,0,0,0,0,0,0,0,0};
  2987.     static char *space10 = "          ";
  2988.  
  2989.     /* These must not be in registers: */
  2990.     char achar;
  2991.     I16 ashort;
  2992.     int aint;
  2993.     unsigned int auint;
  2994.     I32 along;
  2995.     U32 aulong;
  2996. #ifdef HAS_QUAD
  2997.     Quad_t aquad;
  2998.     unsigned Quad_t auquad;
  2999. #endif
  3000.     char *aptr;
  3001.     float afloat;
  3002.     double adouble;
  3003.  
  3004.     items = SP - MARK;
  3005.     MARK++;
  3006.     sv_setpvn(cat, "", 0);
  3007.     while (pat < patend) {
  3008. #define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
  3009.     datumtype = *pat++;
  3010.     if (*pat == '*') {
  3011.         len = strchr("@Xxu", datumtype) ? 0 : items;
  3012.         pat++;
  3013.     }
  3014.     else if (isDIGIT(*pat)) {
  3015.         len = *pat++ - '0';
  3016.         while (isDIGIT(*pat))
  3017.         len = (len * 10) + (*pat++ - '0');
  3018.     }
  3019.     else
  3020.         len = 1;
  3021.     switch(datumtype) {
  3022.     default:
  3023.         break;
  3024.     case '%':
  3025.         DIE("%% may only be used in unpack");
  3026.     case '@':
  3027.         len -= SvCUR(cat);
  3028.         if (len > 0)
  3029.         goto grow;
  3030.         len = -len;
  3031.         if (len > 0)
  3032.         goto shrink;
  3033.         break;
  3034.     case 'X':
  3035.       shrink:
  3036.         if (SvCUR(cat) < len)
  3037.         DIE("X outside of string");
  3038.         SvCUR(cat) -= len;
  3039.         *SvEND(cat) = '\0';
  3040.         break;
  3041.     case 'x':
  3042.       grow:
  3043.         while (len >= 10) {
  3044.         sv_catpvn(cat, null10, 10);
  3045.         len -= 10;
  3046.         }
  3047.         sv_catpvn(cat, null10, len);
  3048.         break;
  3049.     case 'A':
  3050.     case 'a':
  3051.         fromstr = NEXTFROM;
  3052.         aptr = SvPV(fromstr, fromlen);
  3053.         if (pat[-1] == '*')
  3054.         len = fromlen;
  3055.         if (fromlen > len)
  3056.         sv_catpvn(cat, aptr, len);
  3057.         else {
  3058.         sv_catpvn(cat, aptr, fromlen);
  3059.         len -= fromlen;
  3060.         if (datumtype == 'A') {
  3061.             while (len >= 10) {
  3062.             sv_catpvn(cat, space10, 10);
  3063.             len -= 10;
  3064.             }
  3065.             sv_catpvn(cat, space10, len);
  3066.         }
  3067.         else {
  3068.             while (len >= 10) {
  3069.             sv_catpvn(cat, null10, 10);
  3070.             len -= 10;
  3071.             }
  3072.             sv_catpvn(cat, null10, len);
  3073.         }
  3074.         }
  3075.         break;
  3076.     case 'B':
  3077.     case 'b':
  3078.         {
  3079.         char *savepat = pat;
  3080.         I32 saveitems;
  3081.  
  3082.         fromstr = NEXTFROM;
  3083.         saveitems = items;
  3084.         aptr = SvPV(fromstr, fromlen);
  3085.         if (pat[-1] == '*')
  3086.             len = fromlen;
  3087.         pat = aptr;
  3088.         aint = SvCUR(cat);
  3089.         SvCUR(cat) += (len+7)/8;
  3090.         SvGROW(cat, SvCUR(cat) + 1);
  3091.         aptr = SvPVX(cat) + aint;
  3092.         if (len > fromlen)
  3093.             len = fromlen;
  3094.         aint = len;
  3095.         items = 0;
  3096.         if (datumtype == 'B') {
  3097.             for (len = 0; len++ < aint;) {
  3098.             items |= *pat++ & 1;
  3099.             if (len & 7)
  3100.                 items <<= 1;
  3101.             else {
  3102.                 *aptr++ = items & 0xff;
  3103.                 items = 0;
  3104.             }
  3105.             }
  3106.         }
  3107.         else {
  3108.             for (len = 0; len++ < aint;) {
  3109.             if (*pat++ & 1)
  3110.                 items |= 128;
  3111.             if (len & 7)
  3112.                 items >>= 1;
  3113.             else {
  3114.                 *aptr++ = items & 0xff;
  3115.                 items = 0;
  3116.             }
  3117.             }
  3118.         }
  3119.         if (aint & 7) {
  3120.             if (datumtype == 'B')
  3121.             items <<= 7 - (aint & 7);
  3122.             else
  3123.             items >>= 7 - (aint & 7);
  3124.             *aptr++ = items & 0xff;
  3125.         }
  3126.         pat = SvPVX(cat) + SvCUR(cat);
  3127.         while (aptr <= pat)
  3128.             *aptr++ = '\0';
  3129.  
  3130.         pat = savepat;
  3131.         items = saveitems;
  3132.         }
  3133.         break;
  3134.     case 'H':
  3135.     case 'h':
  3136.         {
  3137.         char *savepat = pat;
  3138.         I32 saveitems;
  3139.  
  3140.         fromstr = NEXTFROM;
  3141.         saveitems = items;
  3142.         aptr = SvPV(fromstr, fromlen);
  3143.         if (pat[-1] == '*')
  3144.             len = fromlen;
  3145.         pat = aptr;
  3146.         aint = SvCUR(cat);
  3147.         SvCUR(cat) += (len+1)/2;
  3148.         SvGROW(cat, SvCUR(cat) + 1);
  3149.         aptr = SvPVX(cat) + aint;
  3150.         if (len > fromlen)
  3151.             len = fromlen;
  3152.         aint = len;
  3153.         items = 0;
  3154.         if (datumtype == 'H') {
  3155.             for (len = 0; len++ < aint;) {
  3156.             if (isALPHA(*pat))
  3157.                 items |= ((*pat++ & 15) + 9) & 15;
  3158.             else
  3159.                 items |= *pat++ & 15;
  3160.             if (len & 1)
  3161.                 items <<= 4;
  3162.             else {
  3163.                 *aptr++ = items & 0xff;
  3164.                 items = 0;
  3165.             }
  3166.             }
  3167.         }
  3168.         else {
  3169.             for (len = 0; len++ < aint;) {
  3170.             if (isALPHA(*pat))
  3171.                 items |= (((*pat++ & 15) + 9) & 15) << 4;
  3172.             else
  3173.                 items |= (*pat++ & 15) << 4;
  3174.             if (len & 1)
  3175.                 items >>= 4;
  3176.             else {
  3177.                 *aptr++ = items & 0xff;
  3178.                 items = 0;
  3179.             }
  3180.             }
  3181.         }
  3182.         if (aint & 1)
  3183.             *aptr++ = items & 0xff;
  3184.         pat = SvPVX(cat) + SvCUR(cat);
  3185.         while (aptr <= pat)
  3186.             *aptr++ = '\0';
  3187.  
  3188.         pat = savepat;
  3189.         items = saveitems;
  3190.         }
  3191.         break;
  3192.     case 'C':
  3193.     case 'c':
  3194.         while (len-- > 0) {
  3195.         fromstr = NEXTFROM;
  3196.         aint = SvIV(fromstr);
  3197.         achar = aint;
  3198.         sv_catpvn(cat, &achar, sizeof(char));
  3199.         }
  3200.         break;
  3201.     /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
  3202.     case 'f':
  3203.     case 'F':
  3204.         while (len-- > 0) {
  3205.         fromstr = NEXTFROM;
  3206.         afloat = (float)SvNV(fromstr);
  3207.         sv_catpvn(cat, (char *)&afloat, sizeof (float));
  3208.         }
  3209.         break;
  3210.     case 'd':
  3211.     case 'D':
  3212.         while (len-- > 0) {
  3213.         fromstr = NEXTFROM;
  3214.         adouble = (double)SvNV(fromstr);
  3215.         sv_catpvn(cat, (char *)&adouble, sizeof (double));
  3216.         }
  3217.         break;
  3218.     case 'n':
  3219.         while (len-- > 0) {
  3220.         fromstr = NEXTFROM;
  3221.         ashort = (I16)SvIV(fromstr);
  3222. #ifdef HAS_HTONS
  3223.         ashort = htons(ashort);
  3224. #endif
  3225.         sv_catpvn(cat, (char*)&ashort, sizeof(I16));
  3226.         }
  3227.         break;
  3228.     case 'v':
  3229.         while (len-- > 0) {
  3230.         fromstr = NEXTFROM;
  3231.         ashort = (I16)SvIV(fromstr);
  3232. #ifdef HAS_HTOVS
  3233.         ashort = htovs(ashort);
  3234. #endif
  3235.         sv_catpvn(cat, (char*)&ashort, sizeof(I16));
  3236.         }
  3237.         break;
  3238.     case 'S':
  3239.     case 's':
  3240.         while (len-- > 0) {
  3241.         fromstr = NEXTFROM;
  3242.         ashort = (I16)SvIV(fromstr);
  3243.         sv_catpvn(cat, (char*)&ashort, sizeof(I16));
  3244.         }
  3245.         break;
  3246.     case 'I':
  3247.         while (len-- > 0) {
  3248.         fromstr = NEXTFROM;
  3249.         auint = U_I(SvNV(fromstr));
  3250.         sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
  3251.         }
  3252.         break;
  3253.     case 'i':
  3254.         while (len-- > 0) {
  3255.         fromstr = NEXTFROM;
  3256.         aint = SvIV(fromstr);
  3257.         sv_catpvn(cat, (char*)&aint, sizeof(int));
  3258.         }
  3259.         break;
  3260.     case 'N':
  3261.         while (len-- > 0) {
  3262.         fromstr = NEXTFROM;
  3263.         aulong = U_L(SvNV(fromstr));
  3264. #ifdef HAS_HTONL
  3265.         aulong = htonl(aulong);
  3266. #endif
  3267.         sv_catpvn(cat, (char*)&aulong, sizeof(U32));
  3268.         }
  3269.         break;
  3270.     case 'V':
  3271.         while (len-- > 0) {
  3272.         fromstr = NEXTFROM;
  3273.         aulong = U_L(SvNV(fromstr));
  3274. #ifdef HAS_HTOVL
  3275.         aulong = htovl(aulong);
  3276. #endif
  3277.         sv_catpvn(cat, (char*)&aulong, sizeof(U32));
  3278.         }
  3279.         break;
  3280.     case 'L':
  3281.         while (len-- > 0) {
  3282.         fromstr = NEXTFROM;
  3283.         aulong = U_L(SvNV(fromstr));
  3284.         sv_catpvn(cat, (char*)&aulong, sizeof(U32));
  3285.         }
  3286.         break;
  3287.     case 'l':
  3288.         while (len-- > 0) {
  3289.         fromstr = NEXTFROM;
  3290.         along = SvIV(fromstr);
  3291.         sv_catpvn(cat, (char*)&along, sizeof(I32));
  3292.         }
  3293.         break;
  3294. #ifdef HAS_QUAD
  3295.     case 'Q':
  3296.         while (len-- > 0) {
  3297.         fromstr = NEXTFROM;
  3298.         auquad = (unsigned Quad_t)SvIV(fromstr);
  3299.         sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
  3300.         }
  3301.         break;
  3302.     case 'q':
  3303.         while (len-- > 0) {
  3304.         fromstr = NEXTFROM;
  3305.         aquad = (Quad_t)SvIV(fromstr);
  3306.         sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
  3307.         }
  3308.         break;
  3309. #endif /* HAS_QUAD */
  3310.     case 'P':
  3311.         len = 1;        /* assume SV is correct length */
  3312.         /* FALL THROUGH */
  3313.     case 'p':
  3314.         while (len-- > 0) {
  3315.         fromstr = NEXTFROM;
  3316.         aptr = SvPV_force(fromstr, na);    /* XXX Error if TEMP? */
  3317.         sv_catpvn(cat, (char*)&aptr, sizeof(char*));
  3318.         }
  3319.         break;
  3320.     case 'u':
  3321.         fromstr = NEXTFROM;
  3322.         aptr = SvPV(fromstr, fromlen);
  3323.         SvGROW(cat, fromlen * 4 / 3);
  3324.         if (len <= 1)
  3325.         len = 45;
  3326.         else
  3327.         len = len / 3 * 3;
  3328.         while (fromlen > 0) {
  3329.         I32 todo;
  3330.  
  3331.         if (fromlen > len)
  3332.             todo = len;
  3333.         else
  3334.             todo = fromlen;
  3335.         doencodes(cat, aptr, todo);
  3336.         fromlen -= todo;
  3337.         aptr += todo;
  3338.         }
  3339.         break;
  3340.     }
  3341.     }
  3342.     SvSETMAGIC(cat);
  3343.     SP = ORIGMARK;
  3344.     PUSHs(cat);
  3345.     RETURN;
  3346. }
  3347. #undef NEXTFROM
  3348.  
  3349. PP(pp_split)
  3350. {
  3351.     dSP; dTARG;
  3352.     AV *ary;
  3353.     register I32 limit = POPi;            /* note, negative is forever */
  3354.     SV *sv = POPs;
  3355.     STRLEN len;
  3356.     register char *s = SvPV(sv, len);
  3357.     char *strend = s + len;
  3358.     register PMOP *pm = (PMOP*)POPs;
  3359.     register SV *dstr;
  3360.     register char *m;
  3361.     I32 iters = 0;
  3362.     I32 maxiters = (strend - s) + 10;
  3363.     I32 i;
  3364.     char *orig;
  3365.     I32 origlimit = limit;
  3366.     I32 realarray = 0;
  3367.     I32 base;
  3368.     AV *oldstack = stack;
  3369.     register REGEXP *rx = pm->op_pmregexp;
  3370.     I32 gimme = GIMME;
  3371.     I32 oldsave = savestack_ix;
  3372.  
  3373.     if (!pm || !s)
  3374.     DIE("panic: do_split");
  3375.     if (pm->op_pmreplroot)
  3376.     ary = GvAVn((GV*)pm->op_pmreplroot);
  3377.     else if (gimme != G_ARRAY)
  3378.     ary = GvAVn(defgv);
  3379.     else
  3380.     ary = Nullav;
  3381.     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
  3382.     realarray = 1;
  3383.     if (!AvREAL(ary)) {
  3384.         AvREAL_on(ary);
  3385.         for (i = AvFILL(ary); i >= 0; i--)
  3386.         AvARRAY(ary)[i] = &sv_undef;    /* don't free mere refs */
  3387.     }
  3388.     av_extend(ary,0);
  3389.     av_clear(ary);
  3390.     /* temporarily switch stacks */
  3391.     SWITCHSTACK(stack, ary);
  3392.     }
  3393.     base = SP - stack_base;
  3394.     orig = s;
  3395.     if (pm->op_pmflags & PMf_SKIPWHITE) {
  3396.     while (isSPACE(*s))
  3397.         s++;
  3398.     }
  3399.     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
  3400.     SAVEINT(multiline);
  3401.     multiline = pm->op_pmflags & PMf_MULTILINE;
  3402.     }
  3403.  
  3404.     if (!limit)
  3405.     limit = maxiters + 2;
  3406.     if (pm->op_pmflags & PMf_WHITE) {
  3407.     while (--limit) {
  3408.         /*SUPPRESS 530*/
  3409.         for (m = s; m < strend && !isSPACE(*m); m++) ;
  3410.         if (m >= strend)
  3411.         break;
  3412.         dstr = NEWSV(30, m-s);
  3413.         sv_setpvn(dstr, s, m-s);
  3414.         if (!realarray)
  3415.         sv_2mortal(dstr);
  3416.         XPUSHs(dstr);
  3417.         /*SUPPRESS 530*/
  3418.         for (s = m + 1; s < strend && isSPACE(*s); s++) ;
  3419.     }
  3420.     }
  3421.     else if (strEQ("^", rx->precomp)) {
  3422.     while (--limit) {
  3423.         /*SUPPRESS 530*/
  3424.         for (m = s; m < strend && *m != '\n'; m++) ;
  3425.         m++;
  3426.         if (m >= strend)
  3427.         break;
  3428.         dstr = NEWSV(30, m-s);
  3429.         sv_setpvn(dstr, s, m-s);
  3430.         if (!realarray)
  3431.         sv_2mortal(dstr);
  3432.         XPUSHs(dstr);
  3433.         s = m;
  3434.     }
  3435.     }
  3436.     else if (pm->op_pmshort) {
  3437.     i = SvCUR(pm->op_pmshort);
  3438.     if (i == 1) {
  3439.         I32 fold = (pm->op_pmflags & PMf_FOLD);
  3440.         i = *SvPVX(pm->op_pmshort);
  3441.         if (fold && isUPPER(i))
  3442.         i = toLOWER(i);
  3443.         while (--limit) {
  3444.         if (fold) {
  3445.             for ( m = s;
  3446.               m < strend && *m != i &&
  3447.                 (!isUPPER(*m) || toLOWER(*m) != i);
  3448.               m++)            /*SUPPRESS 530*/
  3449.             ;
  3450.         }
  3451.         else                /*SUPPRESS 530*/
  3452.             for (m = s; m < strend && *m != i; m++) ;
  3453.         if (m >= strend)
  3454.             break;
  3455.         dstr = NEWSV(30, m-s);
  3456.         sv_setpvn(dstr, s, m-s);
  3457.         if (!realarray)
  3458.             sv_2mortal(dstr);
  3459.         XPUSHs(dstr);
  3460.         s = m + 1;
  3461.         }
  3462.     }
  3463.     else {
  3464. #ifndef lint
  3465.         while (s < strend && --limit &&
  3466.           (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
  3467.             pm->op_pmshort)) )
  3468. #endif
  3469.         {
  3470.         dstr = NEWSV(31, m-s);
  3471.         sv_setpvn(dstr, s, m-s);
  3472.         if (!realarray)
  3473.             sv_2mortal(dstr);
  3474.         XPUSHs(dstr);
  3475.         s = m + i;
  3476.         }
  3477.     }
  3478.     }
  3479.     else {
  3480.     maxiters += (strend - s) * rx->nparens;
  3481.     while (s < strend && --limit &&
  3482.         pregexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
  3483.         if (rx->subbase
  3484.           && rx->subbase != orig) {
  3485.         m = s;
  3486.         s = orig;
  3487.         orig = rx->subbase;
  3488.         s = orig + (m - s);
  3489.         strend = s + (strend - m);
  3490.         }
  3491.         m = rx->startp[0];
  3492.         dstr = NEWSV(32, m-s);
  3493.         sv_setpvn(dstr, s, m-s);
  3494.         if (!realarray)
  3495.         sv_2mortal(dstr);
  3496.         XPUSHs(dstr);
  3497.         if (rx->nparens) {
  3498.         for (i = 1; i <= rx->nparens; i++) {
  3499.             s = rx->startp[i];
  3500.             m = rx->endp[i];
  3501.             if (m && s) {
  3502.             dstr = NEWSV(33, m-s);
  3503.             sv_setpvn(dstr, s, m-s);
  3504.             }
  3505.             else
  3506.             dstr = NEWSV(33, 0);
  3507.             if (!realarray)
  3508.             sv_2mortal(dstr);
  3509.             XPUSHs(dstr);
  3510.         }
  3511.         }
  3512.         s = rx->endp[0];
  3513.     }
  3514.     }
  3515.     LEAVE_SCOPE(oldsave);
  3516.     iters = (SP - stack_base) - base;
  3517.     if (iters > maxiters)
  3518.     DIE("Split loop");
  3519.     
  3520.     /* keep field after final delim? */
  3521.     if (s < strend || (iters && origlimit)) {
  3522.     dstr = NEWSV(34, strend-s);
  3523.     sv_setpvn(dstr, s, strend-s);
  3524.     if (!realarray)
  3525.         sv_2mortal(dstr);
  3526.     XPUSHs(dstr);
  3527.     iters++;
  3528.     }
  3529.     else if (!origlimit) {
  3530.     while (iters > 0 && SvCUR(TOPs) == 0)
  3531.         iters--, SP--;
  3532.     }
  3533.     if (realarray) {
  3534.     SWITCHSTACK(ary, oldstack);
  3535.     if (gimme == G_ARRAY) {
  3536.         EXTEND(SP, iters);
  3537.         Copy(AvARRAY(ary), SP + 1, iters, SV*);
  3538.         SP += iters;
  3539.         RETURN;
  3540.     }
  3541.     }
  3542.     else {
  3543.     if (gimme == G_ARRAY)
  3544.         RETURN;
  3545.     }
  3546.     if (iters || !pm->op_pmreplroot) {
  3547.     GETTARGET;
  3548.     PUSHi(iters);
  3549.     RETURN;
  3550.     }
  3551.     RETPUSHUNDEF;
  3552. }
  3553.  
  3554.